FreeRADIUS Date of Birth Check

dob-check.pl

#!/usr/bin/perl
##################################################################
# Copyright (C) 2012 - Jon Agland			    	 #
#								 #
# This program is free software; you can redistribute it and/or  #        
# modify it under the terms of the GNU General Public License    #        
# as published by the Free Software Foundation; either version 2 #        
# of the License, or (at your option) any later version.         #        
#								 #
# This program is distributed in the hope that it will be useful,#        
# but WITHOUT ANY WARRANTY; without even the implied warranty of #        
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  #        
# GNU General Public License for more details.                   #         
##################################################################
 
# Name: dob-check
# Version: 1.01
# Description: This script (dob-check) is intended to be used as perl module
# within FreeRADIUS.  It intends to check LDAP attributes, so that your RADIUS
# can make a decision about granting a user based on Date of Birth. 
# This is important for safeguarding users in the context of a federated RADIUS
# platform e.g. eduroam.  Where it might not be possible to safeguard users
# whilst they are roaming because locally they would be sent via webfilter
#
# To implement refer to rlm_perl.  You will also need to extend your schema,
# based on http://www.terena.org/activities/tf-emc2/docs/schac/schac-20110705-1.4.1.schema.txt
#
# This has only been tested with FreeRADIUS 2.x
 
use Net::LDAP;
use DateTime;
use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
 
    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 LDAPsearch
 {
 
$ldap = Net::LDAP->new ( "ldapserver" ) or die "$@";
 
$mesg = $ldap->bind ( version => 3 );          # use for searches
$mesg = $ldap->bind ( "cn=ldap,cn=Users",password => "password", version => 3 ); 
 
   my ($ldap,$searchString,$attrs,$base) = @_;
   if (!$base ) { $base = "cn=Users"; }
   if (!$attrs ) { $attrs = [ 'cn','schacDateOfBirth' ]; }
   my $result = $ldap->search ( base    => "$base",
                                scope   => "sub",
                                filter  => "$searchString",
                                attrs   =>  $attrs
                              );
 
}
 
sub authorize {
 
my @Attrs = ('cn','schacDateOfBirth');               # request all available attributes
                                # to be returned.
 
my $UPN = $RAD_REQUEST{'User-Name'};
 
my $result = LDAPsearch ( $ldap, "(UserPrincipalName=$UPN)", \@Attrs );
 
@entries = $result->entries;
 
foreach $entry (@entries) {
	$dob = $entry->get_value("schacDateOfBirth");
 
}
 
$ldap -> unbind;
 
# if you comment about this block then it will always return OK, because it's less than 1970 :)
 
if ($dob eq '' ) {
&radiusd::radlog(6, "dob-check: User-Name = ${UPN} schacDateOfBirth = ${dob} - no dob set returning USERLOCK ");
 return RLM_MODULE_USERLOCK; }
 
my $time = time;
my $eighteenyears = 568079997;
my $dobeighteen = time-$eighteenyears;
 
my $dobday = substr ($dob, 6, 2);
my $dobmonth = substr ($dob, 4, 2);
my $dobyear = substr ($dob, 0, 4);
 
if ($dobyear < 1970) {
&radiusd::radlog(6, "dob-check: User-Name = ${UPN} schacDateOfBirth = ${dob} - user dob before epoch - returning OK");
 return RLM_MODULE_OK; }
 
$dt = DateTime->new ( year => $dobyear, month => $dobmonth, day =>$dobday);
 
my $dobepoch = $dt->epoch;
 
if ($dobepoch < $dobeighteen) {
&radiusd::radlog(6, "dob-check: User-Name = ${UPN} schacDateOfBirth = ${dob} - user is over 18 - returning OK");
 return RLM_MODULE_OK; }
		 else { 
&radiusd::radlog(6, "dob-check: User-Name = ${UPN} schacDateOfBirth = ${dob} - user is under 18 - returning USERLOCK");
return RLM_MODULE_USERLOCK; }
 
}