checkrad.pl.in

radius server在linux下的源码

#	Check an Ascend Max4000 or similar model via finger
#
#	Note: Not all software revisions support finger
#	      You may also need to enable the finger option.
#
#	Author: Shiloh Costa of MDI Internet Inc. <[e-mail]>
#
sub max40xx_finger {
	open(FD, "$finger $ARGV[3]\@$ARGV[1]|");
	while(<FD>) {
	   $line = $_;
	   if( $line =~ /Session/ ){
		next;
	   }

	   if( $line =~ /$ARGV[4]/ ){
	      return 1; # user is online
	   }
	}
	close FD;
	return 0; # user is offline
}


#
#	Check an Ascend Max4000 or similar model via SNMP
#
#	Author: Blaz Zupan of Medinet <[e-mail]>
#
$asm   = '.iso.org.dod.internet.private.enterprises.529';
sub ascend_snmp {
	my $sess_id;
	my $l1, $l2;

	$l1 = '';
	$l2 = '';

	#
	#	If it looks like hex, only try it as hex,
	#	otherwise try it as both decimal and hex.
	#
	$sess_id = $ARGV[4];
	if ($sess_id !~ /^0/ && $sess_id !~ /[a-f]/i) {
		$l1 = snmpget($ARGV[1], "$cmmty_string", "$asm.12.3.1.4.$sess_id");
	}
	if (!$l1){
		$sess_id = hex $ARGV[4];
		$l2 = snmpget($ARGV[1], "$cmmty_string", "$asm.12.3.1.4.$sess_id");
	}

	print LOG "  user at port S$ARGV[2]: $l1 (dec)\n" if ($debug && $l1);
	print LOG "  user at port S$ARGV[2]: $l2 (hex)\n" if ($debug && $l2);

	(($l1 && $l1 eq $ARGV[3]) || ($l2 && $l2 eq $ARGV[3])) ? 1 : 0;
}


#
#	See if the user is logged in using the portslave finger.
#
sub portslave_finger {
	my ($Port_seen);

	$Port_seen = 0;

	open(FD, "$finger \@$ARGV[1]|");
	while(<FD>) {
		#
		#	Check for ^Port. If we don't see it we
		#	wont get confused by non-portslave-finger
		#	output too.
		#
		if (/^Port/) {
			$Port_seen++;
			next;
		}
		next if (!$Port_seen);
		next if (/^---/);

		($port, $user) = /^.(...) (...............)/;

		$port =~ s/ .*//;
		$user =~ s/ .*//;
		$ulen = length($user);
		#
		#	HACK: strip [PSC] from the front of the username,
		#	and things like .ppp from the end.
		#
		$user =~ s/^[PSC]//;
		$user =~ s/\.(ppp|slip|cslip)$//;

		#
		#	HACK: because ut_user usually has max. 8 characters
		#	we only compare up the the length of $user if the
		#	unstripped name had 8 chars.
		#
		$argv_user = $ARGV[3];
		if ($ulen == 8) {
			$ulen = length($user);
			$argv_user = substr($ARGV[3], 0, $ulen);
		}

		if ($port == $ARGV[2]) {
			if ($user eq $argv_user) {
				print LOG "  $user matches $argv_user " .
					"on port $port" if ($debug);
				close FD;
				return 1;
			} else {
				print LOG "  $user doesn't match $argv_user " .
					"on port $port" if ($debug);
				close FD;
				return 0;
			}
		}
	}
	close FD;
	0;
}

#
#	See if the user is already logged-in at the 3Com/USR Total Control.
#	(this routine by Alexis C. Villalon <[e-mail]>).
#	You must have the Net::Telnet module from CPAN for this to work.
#	You must also have your /etc/raddb/naspasswd made up.
# 
sub tc_tccheck {
	#
	#	Localize all variables first.
	#
	my ($Port_seen, $ts, $terminalserver, $log, $login, $pass, $password);
	my ($telnet, $curprompt, $curline, $ok, $totlines, $ccntr);
	my (@curlines, @cltok, $user, $port, $ulen);

	return 2 unless (check_net_telnet());

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

	#
	#	Communicate with NAS using Net::Telnet, then issue
	#	the command "show sessions" to see who are logged in.
	#	Thanks to Chris Jackson <[e-mail]> for the
	#	for the "-- Press Return for More --" workaround.
	#
	$telnet = new Net::Telnet (Timeout => 5,
				   Prompt => '/\>/');
	$telnet->open($terminalserver);
	$telnet->login($login, $password);
	$telnet->print("show sessions");
	while ($curprompt ne "\>") {
		($curline, $curprompt) = $telnet->waitfor
			(String => "-- Press Return for More --",
			 String => "\>",
			 Timeout => 5);
		$ok = $telnet->print("");
		push @curlines, split(/^/m, $curline);
	}
	$telnet->close;
	#
	#	Telnet closed.  We got the info.  Let's examine it.
	#
	$totlines = @curlines;
	$ccntr = 0;
	while($ccntr < $totlines) {
		#
		#	Check for ^Port.
		#
		if ($curlines[$ccntr] =~ /^Port/) {
			$Port_seen++;
			$ccntr++;
			next;
		}
		#
		#	Ignore all unnecessary lines.
		#
		if (!$Port_seen || $curlines[$ccntr] =~ /^---/ ||
			$curlines[$ccntr] =~ /^ .*$/) {
			$ccntr++;
			next;
		}
		#
		#	Parse the current line for the port# and username.
		#
		@cltok = split(/\s+/, $curlines[$ccntr]);
		$ccntr++;
		$port = $cltok[0];
		$user = $cltok[1];
		$ulen = length($user);
		#
		#	HACK: strip [PSC] from the front of the username,
		#	and things like .ppp from the end.  Strip S from
		#	the front of the port number.
		#
		$user =~ s/^[PSC]//;
		$user =~ s/\.(ppp|slip|cslip)$//;
		$port =~ s/^S//;
		#		
		#	HACK: because "show sessions" shows max. 15 characters
		#	we only compare up to the length of $user if the
		#	unstripped name had 15 chars.
		#
		$argv_user = $ARGV[3];
		if ($ulen == 15) {
			$ulen = length($user);
			$argv_user = substr($ARGV[3], 0, $ulen);
		}
		if ($port == $ARGV[2]) {
			if ($user eq $argv_user) {
				print LOG "  $user matches $argv_user " .
					"on port $port" if ($debug);
				return 1;
			} else {
				print LOG "  $user doesn't match $argv_user " .
					"on port $port" if ($debug);
				return 0;
			}
		}
	}
	0;
}

#
#	Check a Cyclades PathRAS via telnet
#
#	Version: 1.2
#
#	Author: Antonio Dias of SST Internet <[e-mail]>
#
sub cyclades_telnet {
	#
	#	Localize all variables first.
	#
	my ($pr, $pr_login, $pr_passwd, $pr_prompt, $endlist, @list, $port, $user);
	#
	#	This variable must match PathRAS' command prompt 
	#	string as entered in menu option 6.2.
	#	The value below matches the default command prompt.
	#
	$pr_prompt = '/Select option ==\>$/i';

	#
	#	This variable match the end of userslist.
	#
	$endlist = '/Type \<enter\>/i';

	#
	#	Do we have Net::Telnet installed?
	#
	return 2 unless (check_net_telnet());

	#
	#	Get login name and password for NAS 
	#	from $naspass file.
	#
	($pr_login, $pr_passwd) = naspasswd($ARGV[1], 1);

	#
	#	Communicate with PathRAS using Net::Telnet, then access
	#	menu option 6.8 to see who are logged in.
	#	Based on PathRAS firmware version 1.2.3
	#
	$pr = new Net::Telnet (
		Timeout		=> 5,
		Host		=> $ARGV[1],
		ErrMode		=> 'return'
	) || return 2;

	#
	#	Force PathRAS shows its banner.
	#
	$pr->break();

	#
	#	Log on PathRAS
	#
	if ($pr->waitfor(Match => '/login : $/i') == 1) {
		$pr->print($pr_login);
	} else { 
		print LOG " Error: sending login name to PathRAS\n" if ($debug);
		$pr->close;
		return 2;	
	}

	if ($pr->waitfor(Match => '/password : $/i') == 1) {
		$pr->print($pr_passwd);
	} else { 
		print LOG " Error: sending password to PathRAS.\n" if ($debug);
		$pr->close;
		return 2;	
	}

	$pr->print();

	#
	#	Access menu option 6 "PathRAS Management"
	#
	if ($pr->waitfor(Match => $pr_prompt) == 1) {
		$pr->print('6');
	} else { 
		print LOG "  Error: acessing menu option '6'.\n" if ($debug);
		$pr->close;
		return 2;
	}
	#
	#	Access menu option 8 "Show Active Ports"
	#
	if ($pr->waitfor(Match => $pr_prompt) == 1) {
		@list = $pr->cmd(String => '8', Prompt => $endlist);
	} else { 
		print LOG "  Error: acessing menu option '8'.\n" if ($debug);
		$pr->close;
		return 2;
	}
	#
	#	Since we got the info we want, let's close 
	#	the telnet session
	#
	$pr->close;

	#
	#	Lets examine the userlist stored in @list
	#
	foreach(@list) {
		#
		#	We are interested in active sessions only
		#
		if (/Active/i) {
			($port, $user) = split;
			#
			#	Strip out any prefix, suffix and
			#	realm from $user check to see if
			#	$ARGV[3] matches.
			#
			if(strip_username($ARGV[3]) eq strip_username($user)) {
				print LOG "  User '$ARGV[3]' found on '$ARGV[1]:$port'.\n" if ($debug);
				return 1;
			}
		}
	}
	print LOG "  User '$ARGV[3]' not found on '$ARGV[1]'.\n" if ($debug);
   	0;
}

#
#	Check a Patton 2800 via SNMP
#
#	Version: 1.0
#
#	Author: Antonio Dias of SST Internet <[e-mail]>
#
sub patton_snmp {
   my($oid);

   #$oid = '.1.3.6.1.4.1.1768.5.100.1.40.' . hex $ARGV[4];
   # Reported by "Andria Legon" <[e-mail]>
   # The OID below should be the correct one instead of the one above.
   $oid = '.1.3.6.1.4.1.1768.5.100.1.56.' . hex $ARGV[4];
   #
   # Check if the session still active
   # 
   if (snmpget($ARGV[1], "monitor", "$oid") == 0) {
      print LOG "  Session $ARGV[4] still active on NAS " . 
      	"$ARGV[1], port $ARGV[2], for user $ARGV[3].\n" if ($debug);
      return 1;
   }
   0;
}

#
#      Check a Digitro BXS via rusers
#
#      Version: 1.1
#
#      Author: Antonio Dias of SST Internet <[e-mail]>
#
sub digitro_rusers {
   my ($ret);
   local $_;

   if (-e $rusers && -x $rusers) {
      #
      # Get a list of users logged in via rusers
      #
      $_ = `$rusers $ARGV[1]`;
      $ret = ((/$ARGV[3]/) ? 1 : 0);
   } else {
      print LOG "   Error: can't execute $rusers\n" if $debug;
      $ret = 2;
   }
   $ret;
}

#
#	Check Cyclades PR3000 and PR4000 via SNMP
#
#	Version: 1.0
#
#	Author: Antonio Dias of SST Internet <[e-mail]>
#
sub cyclades_snmp {
   my ($oid, $ret);
   local $_;
   
   $oid = ".1.3.6.1.4.1.2925.3.3.6.1.1.2";

   $_ = snmpwalk($ARGV[1],"$cmmty_string",$oid);
   $ret = ((/$ARGV[3]/) ? 1 : 0);
   $ret;
}

#
#	3Com/USR HiPer Arc Total Control.
#	This works with HiPer Arc 4.0.30
#	(this routine by Igor Brezac <[e-mail]>)
# 

#       This routine modified by Dan Halverson <[e-mail]>
#       to suport additional versions of Hiper Arc
#

$usrm	 = '.iso.org.dod.internet.private.enterprises.429';
sub usrhiper_snmp {
	my ($login,$password,$oidext);

	# Look up community string in naspasswd file.
        ($login, $password) = naspasswd($ARGV[1], 1);
	if ($login && $login ne 'SNMP') {
		if($debug) {
			print LOG
			"   Error: Need SNMP community string for $ARGV[1]\n";
		}
		return 2;
	} else {
# If password is defined in naspasswd file, use it as community, otherwise use $cmmty_string
		if ($password eq '') {
		    $password = "$cmmty_string";
		}	
	}
	my ($ver) = get_hiper_ver(usrm=>$usrm, target=>$ARGV[1], community=>$password);
	$oidext = get_oidext(ver=>$ver, tty=>$ARGV[2]);
	my ($login);

	$login = snmpget($ARGV[1], $password, "$usrm.4.10.1.1.18.$oidext");
	if ($login =~ /\"/) {
		$login =~ /^.*\"([^"]+)\"/;
		$login = $1;
	}

	print LOG "  user at port S$ARGV[2]: $login\n" if ($debug);

	($login eq $ARGV[3]) ? 1 : 0;
}

#
#     get_hiper_ver and get_oidext by Dan Halverson <[e-mail]>
#
sub get_hiper_ver {
    my (%args) = @_;
    my ($ver
	);
    $ver = snmpget ($args{'target'}, $args{'community'}, $args{'usrm'}.".4.1.14.0");
    return($ver);
}

#     
#   Add additional OID checks below before the else.
#   Else is for 4.0.30
#
sub get_oidext {
    my (%args) = @_;
    my ($oid
	);
    if ($args{'ver'} =~ /V5.1.99/) {
	$oid = $args{'tty'}+1257-1;