#!/usr/bin/perl
#==========================================================================================
#
# Script:               checkradd.pl
# Version:              0.1
# Author:               Matthew Schumacher (matt.s@aptalaska.net)
# Purpose:              To check the nas for active logins.
# Sample Syntax:        Pass it 'CHECK <NASIP> <PORT> <USERNAME> <SESSIONID>'
#
# Notes:                This perl script is a daemon that is designed to handle
#			snmp queries while only requiring freeradius to call
#			a lightweight binary client.
#
# Requirements:         SNMP_Session (http://www.switch.ch/misc/leinen/snmp/perl/)
#                       IO::Socket
#
# History:
#
# 2003-08-12 (schu)	First documented version is born
# 2004-01-19 (schu)	commited to cvs
#
#
#==========================================================================================

#==========================================================================================
# Start user defined vars:
#==========================================================================================

my $port           = 5555;
my $configfile     = "/usr/local/freeradius/etc/raddb/clients.conf";
my $logfile        = "/var/log/radius/duplicate.log";
my $debug          = 1;

#==========================================================================================
# End user defined vars:
#==========================================================================================

use BER;
use Socket;
use SNMP_Session;
use IO::Socket;
use Net::hostent;
use POSIX;
use strict;

my %config = parse_config();


my $main_sock = new IO::Socket::INET (LocalHost => '127.0.0.1',
                                      LocalPort => $port,
                                      Listen    => 5,
                                      Proto     => 'tcp',
                                      Reuse     => 1,
                                    );

if(! $main_sock) { die "Socket could not be created. Reason: $!\n"; }

$SIG{CHLD} = "IGNORE";

while(my $new_sock = $main_sock->accept()){
  
  defined (my $pid = fork()) or die("Can't fork child: $!");

  if ($pid == 0) {

    my $hostinfo = gethostbyaddr($new_sock->peeraddr);
    printf "Connect from %s\n", $hostinfo->name if ($debug);

    print $new_sock "radcheck Server Ready:\n";

    # Child process
    while (<$new_sock>) {

      print "The Client said: '$_'\n" if ($debug);

      if(m/^CHECK\s(.+)/gi) {
        my ($nas_ip, $nas_port, $login, $session_id) = split(/\s+/, $1);
        my $nastype  = $config{$nas_ip}{nastype};
        my $password = $config{$nas_ip}{password};

        if((length($nastype) > 0) && ($nastype ne "nocheck")) {

          print "calling $nastype($nas_ip, $nas_port, $login, $session_id, $password)\n" if ($debug);
          my $ret = eval "$nastype(\$nas_ip, \$nas_port, \$login, \$session_id, \$password);";

          if($ret) {
            print "Found the user, sending 1 back to client\n\n" if ($debug);
            `echo "\`date\`: Dupliate login for user $login" >> $logfile`;
            print $new_sock "1\n";
          } else {
            `echo "\`date\`: Did NOT find dupliate login for user $login" >> $logfile`;
            print "Did not find the user, sending 0 back to client\n\n" if ($debug);
            print $new_sock "0\n";
          }
 
        } else {

          if($nastype eq "nocheck") {
            print "nastype is nocheck, returning 0\n\n" if ($debug);
          } else {
            print "NAS not found in $configfile, sending 0 back to client\n\n" if ($debug);
          }

          print $new_sock "0\n";

        }

      }

      #last if /^QUIT/;
      if(/QUIT/){ 
        print "Closing connection on client\n" if ($debug);
        close($new_sock);
        exit;
      }

    }

    $new_sock->shutdown(2);
    close($new_sock);
    exit;

  }

}

close ($main_sock);

#==========================================================================================
# old subs for checking the NAS
#==========================================================================================
sub snmpget {
  my ($host, $community, $OID) = @_;
  print "snmpget checking: $host, $community, $OID\n" if ($debug);
  my ($ret);
  local $_;
  my (@enoid, $var,$response, $bindings, $binding, $value);
  my ($inoid, $outoid, $upoid, $oid, @retvals);
             
  $OID =~ s/^.iso.org.dod.internet.private.enterprises/.1.3.6.1.4.1/;

  push @enoid,  encode_oid((split /\./, $OID));
  srand();

  my $session = SNMP_Session->open($host, $community, 161);
  if (!$session->get_request_response(@enoid)) {
    my $e = "No SNMP answer from $host.";
    print LOG "$e\n" if ($debug);
    print STDERR "checkrad: $e\n";
    return "";
  }

  $response = $session->pdu_buffer;
  ($bindings) = $session->decode_get_response ($response);
  $session->close ();

  while ($bindings) {
    ($binding,$bindings) = decode_sequence ($bindings);
    ($oid,$value) = decode_by_template ($binding, "%O%@");
    my $tempo = pretty_print($value);
    $tempo=~s/\t/ /g;
    $tempo=~s/\n/ /g;
    $tempo=~s/^\s+//;
    $tempo=~s/\s+$//;
    push @retvals, $tempo;
  }

  $retvals[0];

}

sub strip_username {
        my ($user) = @_;
        #
        #       Trim white spaces.
        #
        $user =~ s/^\s*(.*?)\s*$/$1/;
        #
        #       Strip out domains, prefix and suffixes
        #
        $user =~ s/\@(.)*$//;
        $user =~ s/^[PSC]//;
        $user =~ s/\.(ppp|slip|cslip)$//;
        $user;
}

#==========================================================================================
# schu's client.conf parser.  Watch for bugs!!!
#==========================================================================================
sub parse_config {

  my ($insideconfig, $password, $nastype, $login, $nas_ip, %config, $key, $val);

  $insideconfig = 0;

  # open the config file
  open ( CONFIGFILE, $configfile) ||
    die "\n Can't open config file ($configfile)\n";

  # create array with config file
  my @aryconfigfile = <CONFIGFILE>;

  foreach my $confline (@aryconfigfile){

    # skip if this line is a comment
    if($confline =~ /^#(.+)/){
      next;
    }

    # remove whitespace from the front of any options we find
    if($confline =~ /^\s+(.+)/){
      $confline = $1;
    }

    # look for the start of a client config
    if($confline =~ /client\s+(.+)\{/) {
      $nas_ip = $1;
      chop($nas_ip);
      undef($password);
      undef($nastype);
      undef($login);
      $insideconfig = 1;
      next;
    }

    # look for the end of a server config
    if($confline =~ /\}/) {
      $insideconfig = 0;
      %config = (%config, $nas_ip => { password => $password, nastype => $nastype, login => $login });

    }

    # if we are in a config read in the hostname and ipaddress
    if($insideconfig == 1){

      if($confline =~ /password\s+=\s+(.+)/){
        $password = $1;
      }
      if($confline =~ /nastype\s+=\s+(.+)/){
        $nastype = $1;
      }
      if($confline =~ /login\s+=\s+(.+)/){
        $login = $1;
      }

    }
  }

  if ($debug) {
    print "Parsing Config file, found the following NASs\n";
    foreach $key ( keys %config ) {
      print "NAS $key: ";
      foreach $val ( keys %{ $config{$key} } ) {
         print "$val=$config{$key}{$val} ";
      }
      print "\n";
    }
    print "\n";
  }

  return %config;

}

# NAS routines will be called with "nastype($nas_ip, $nas_port, $login, $session_id, $password);"

#======================================================================
#       3Com/USR HiPer Arc Total Control.
#       This works with HiPer Arc 4.0.30
#       (this routine by Igor Brezac <igor@ipass.net>)
#
#
#       This routine modified by Dan Halverson <danh@tbc.net>
#       to suport additional versions of Hiper Arc
#       Modified by Schu to work with the new checkradd.pl
#======================================================================
sub usrhiper_snmp {
  
  my ($nas_ip, $nas_port, $login, $session_id, $password) = @_;
  my ($oid, $curuser, $ver, $usrm, $hiper_density);

  $usrm = '.iso.org.dod.internet.private.enterprises.429'; 
  $hiper_density  = 256;

  $ver = snmpget($nas_ip, $password, "$usrm.4.1.14.0");
  print "Found userhiper version: $ver\n" if ($debug);

  if ($ver =~ /V5.1.99/) {
    $oid = $nas_port+1257-1;
  } else {
    $oid = 1257 + 256*int(($nas_port-1) / $hiper_density) + (($nas_port-1) % $hiper_density);
  }

  my $curuser = snmpget($nas_ip, $password, "$usrm.4.10.1.1.18.$oid");
  if ($curuser =~ /\"/) {
    $curuser =~ /^.*\"([^"]+)\"/;
    $curuser = $1;
  }

  print "Found user at port S$nas_port: $curuser, looking for $login\n" if ($debug);

  if($curuser eq $login) {
    return 1; 
  } else {
    return 0;
  }

}

#======================================================================
#       See if the user is logged in using the Cisco MIB
#======================================================================
sub cisco_snmp {


        my ($nas_ip, $nas_port, $login, $session_id, $password) = @_;
        my ($csm, $sess_id, $curuser);

        $csm = '.iso.org.dod.internet.private.enterprises.9';
        $sess_id = hex($session_id);

        if ($nas_port < 20000) {
                #
                #       The AS5350 doesn't support polling the session ID,
                #       so we do it based on nas-port-id. This only works
                #       for analog sessions where port < 20000.
                #       Yes, this means that simultaneous-use on the as5350
                #       doesn't work for ISDN users.
                #
                $curuser = snmpget($nas_ip, $password, "$csm.2.9.2.1.18.$nas_port");
                print "  user at port S$nas_port: $curuser, looking for $login\n" if ($debug);
        } else {
                $curuser = snmpget($nas_ip, $password, "$csm.9.150.1.1.3.1.2.$sess_id");
                print "  user with session id $nas_port ($sess_id): " . "$curuser\n" if ($debug);
        }

        if( $curuser eq $login ) {
                return 1;
        } else {
		return 0;
        }
}