#
# netams4-freeradius-bridge.pl
# http://www.netams.com/
#
#

use constant WNAM_HOST => "127.0.0.1";
use constant MAC_PASS => "password";

use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
use Data::Dumper;
use IO::Socket::INET;
use IO::Select;
use MIME::Base64;

$| = 1; 

my $sock;

use constant    RLM_MODULE_REJECT=>    0;#  /* immediately reject the request */
use constant    RLM_MODULE_FAIL=>      1;#  /* module failed, don't reply */
use constant    RLM_MODULE_OK=>        2;#  /* the module is OK, continue */
use constant    RLM_MODULE_HANDLED=>   3;#  /* the module handled the request, so stop. */
use constant    RLM_MODULE_INVALID=>   4;#  /* the module considers the request invalid. */
use constant    RLM_MODULE_USERLOCK=>  5;#  /* reject the request (user is locked out) */
use constant    RLM_MODULE_NOTFOUND=>  6;#  /* user not found */
use constant    RLM_MODULE_NOOP=>      7;#  /* module succeeded without doing anything */
use constant    RLM_MODULE_UPDATED=>   8;#  /* OK (pairs modified) */
use constant    RLM_MODULE_NUMCODES=>  9;#  /* How many return codes there are */

sub authorize {
        my $result;
		if ($RAD_REQUEST{"User-Name"} eq "00:00:00:00:00:00") { # for internal keepalive check 
			$RAD_CHECK{'Cleartext-Password'}=MAC_PASS;
			$RAD_CHECK{'Auth-Type'}='PAP';
			return RLM_MODULE_OK; 
		}
        $result = &call_wnam("AUTH", \%RAD_REPLY);
# uncomment next line to see raw WNAM text response to RADIUS request        
#        &radiusd::radlog(1, "authorize reply: .$result.");
        if ($result eq 'OK' or $result eq 'NC') { 
        	if (defined $RAD_REQUEST{'CHAP-Password'}) {
               $RAD_CHECK{'Cleartext-Password'}=MAC_PASS;
               $RAD_CHECK{'Auth-Type'}='CHAP';
        	} else {
			   $RAD_CHECK{'Cleartext-Password'}=$RAD_REQUEST{'User-Password'};
               $RAD_CHECK{'Auth-Type'}='PAP';
        	}
			&log_request_attributes;
			return RLM_MODULE_OK; 
        }
        elsif ($result eq 'FAIL') { return RLM_MODULE_OK; }
        elsif ($result eq 'REJECT') { return RLM_MODULE_REJECT; }
        else { return RLM_MODULE_NOOP; }  
}

sub accounting {
        &log_request_attributes;
        if (not defined $RAD_REQUEST{"User-Name"}) { return RLM_MODULE_NOOP; } 
        my $result = &call_wnam("ACCT", \%RAD_CHECK);
        if ($result eq 'OK') { return RLM_MODULE_OK; }
        else { return RLM_MODULE_NOOP; }
}

sub preacct {
        &log_request_attributes;
        if (not defined $RAD_REQUEST{"User-Name"}) { return RLM_MODULE_NOOP; } 
        my $result = &call_wnam("ACCT", \%RAD_CHECK);
        if ($result eq 'OK') { return RLM_MODULE_OK; }
        else { return RLM_MODULE_NOOP; }
}

sub post_auth {
        &log_request_attributes;
        my $result = &call_wnam("AUTH", \%RAD_REPLY);
        if ($result eq 'OK' or $result eq 'NC') {
              return RLM_MODULE_OK; 
        }
        elsif ($result eq 'FAIL') { return RLM_MODULE_OK; }
        elsif ($result eq 'REJECT') { return RLM_MODULE_REJECT; }
        else { return RLM_MODULE_NOOP; }
}

sub detach {
        $sock->close();
#        &radiusd::radlog(0,"rlm_perl::Detaching. Reloading. Done.");
}

sub log_request_attributes {
        for (keys %RAD_REQUEST) {
#                &radiusd::radlog(1, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");
        }
        for (keys %RAD_REPLY) {
#                &radiusd::radlog(1, "RAD_REPLY: $_ = $RAD_REPLY{$_}");
        }
        for (keys %RAD_CHECK) {
#                &radiusd::radlog(1, "RAD_CHECK: $_ = $RAD_CHECK{$_}");
        }
}

sub call_wnam {
        my $cmd=shift;
        my $onto=shift;
        my $datagram;
        
        if (not defined $sock) { newsock(); }
        elsif (0 == recv($sock, $datagram, 1, MSG_PEEK | MSG_DONTWAIT)) { undef $sock; } 
        
        if (not defined $sock) { newsock(); }
        if (not defined $sock) { return 'NC'; }


        my @request;
        for (keys %RAD_REQUEST) { 
                if (!($_ eq "Event-Timestamp") and !($_ eq "Connect-Info") and !($_ eq "User-Password")) {
                        if (ref($RAD_REQUEST{$_}) eq "ARRAY") {
                                my $pp = $RAD_REQUEST{$_};
#								&radiusd::radlog(1, "--1: @pp");
                                for $p (@{$pp}) {
                                        $p =~ /"([^"]*)"/;
                                        $p =~ s/\s+//g;
                                        my($a,$b)=split(/=/, $p);
#                                        &radiusd::radlog(1, "--2: $_ $a $b");
                                        if ($a eq "dhcp-option") {
                                        	if (index($b, '\000\014')!=-1) {
                                        		$b = substr($b, 16);
                                        		push (@request, "$_-$a=$b");
                                        	} 
                                        } else {
	                                        while (index($b, '\\')!=-1) {
                                                $b = substr($b, 4);
	                                        }
	                                    if ($b eq "") { 
		                                    	$v = "$_=$a"; 
		                                    	if (0==grep(/^$v/, @request)) { push (@request, $v); } 
	                                    	} else { 
	                                    		push (@request, "$_-$a=$b"); 
	                                    	}
	                                    }
                                }
                        }
                        elsif ( ($_ eq "Cisco-AVPair") || ($_ eq "Colubris-AVPair") ){
                        	my $p = $RAD_REQUEST{$_};
							$p =~ /"([^"]*)"/;
							$p =~ s/\s+//g;
							my($a,$b)=split(/=/, $p);
#							&radiusd::radlog(1, "--3: $_ $a $b");
                        	push (@request, "$_-$a=$b");
                        }
                        elsif ($_ eq "Aruba-Location-Id"){
                        	$v = $RAD_REQUEST{$_};
                        	$v =~ s/\s+/_/g; 
                            push (@request, "$_=$v");
                        }
                        else {
                                push (@request, "$_=$RAD_REQUEST{$_}");
                        }
                }
        }
        my $data = join (" ", @request);
        print $sock "$cmd $data\n";
#        &radiusd::radlog(1, "WNAM Q: $cmd $data");

        my @ready = IO::Select->new($sock)->can_read(3);
        if (@ready) {
                &radiusd::radlog(1, "RECV: " . join (" ", @ready));
                $sock->recv($datagram, 16384);
        } else {
#               &radiusd::radlog(1, "RECV: timeout");
                return 'NC';
        }

#        &radiusd::radlog(1, "WNAM A: $datagram (".length($datagram).")");

        my $status;
        ($status, $data) = split (/ /, $datagram, 2);
        if ($status ne 'OK') { return $status; }
        my @response = split (/\n+/, $data);
        for (@response) {
               my($a,$b)=split(/=/, $_, 2);
#               &radiusd::radlog(1, "put $a -> $b");
               if (defined $onto->{$a}){
                my $m = $onto->{$a};
                undef $onto->{$a};
                push(@$m, $b);
                $onto->{$a}=$m;
               } else {
                my @m = ($b);
                $onto->{$a}=\@m;
               }
        }
        return $status;
}


sub newsock {        
        if (not defined $sock) {
#                &radiusd::radlog(1, "sock not defined, opening...");
                $sock = new IO::Socket::INET(PeerAddr => WNAM_HOST, PeerPort => 20001, Proto => 'tcp', Timeout => 0.5) or undef $sock;
        }
        if (not defined $sock) {
#                &radiusd::radlog(1, "sock still not defined.");
        } else { 
#                &radiusd::radlog(1, "sock = $sock");
        }
}

newsock();