radius-using-gapps.pl

# vim:expandtab:sw=4 sts=4
#  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.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
#
#  Copyright 2002  The FreeRADIUS server project
#  Copyright 2002  Boian Jordanov <[email protected]>
#

use strict;
use warnings;

use Data::Dumper;
# from libnet-smtp-ssl-perl
use Net::SMTP::SSL;

# Bring the global hashes into the package scope
our (
  # This is hash wich hold original request from radius
  %RAD_REQUEST,
  # In this hash you add values that will be returned to NAS.
  %RAD_REPLY,
  # This is for "control:" items
  %RAD_CHECK,
);

# This is configuration items from "config" perl module configuration section
#my %RAD_PERLCONF;

#
# This the remapping of return values
#
use constant {
        RLM_MODULE_REJECT   => 0, # immediately reject the request
        RLM_MODULE_OK       => 2, # the module is OK, continue
        RLM_MODULE_HANDLED  => 3, # the module handled the request, so stop
        RLM_MODULE_INVALID  => 4, # the module considers the request invalid
        RLM_MODULE_USERLOCK => 5, # reject the request (user is locked out)
        RLM_MODULE_NOTFOUND => 6, # user not found
        RLM_MODULE_NOOP     => 7, # module succeeded without doing anything
        RLM_MODULE_UPDATED  => 8, # OK (pairs modified)
        RLM_MODULE_NUMCODES => 9  # How many return codes there are
};

# Same as src/include/radiusd.h
use constant        L_DBG=>   1;
use constant        L_AUTH=>  2;
use constant        L_INFO=>  3;
use constant        L_ERR=>   4;
use constant        L_PROXY=> 5;
use constant        L_ACCT=>  6;


# Function to handle authorize
sub authorize {
        &radiusd::radlog(L_DBG, "hello from sub authorize");
        # For debugging purposes only
        &log_request_attributes;

        &radiusd::radlog(L_DBG, "sub authorize adding Auth-Type");
        $RAD_CHECK{'Auth-Type'} = 'perl';

        &radiusd::radlog(L_DBG, "sub authorize <- MODULE_OK");
        return RLM_MODULE_OK;
}

# Function to handle authenticate
sub authenticate {
        &radiusd::radlog(L_DBG, "hello from sub authenticate");
        # For debugging purposes only
        &log_request_attributes;

        my $username = $RAD_REQUEST{'User-Name'};
        my $password = $RAD_REQUEST{'User-Password'};

        my $smtp = Net::SMTP::SSL->new(
                        'smtp.gmail.com',
                        Port => 465,
                        Debug => 1,  # although I don't know where this goes
                        );
        &radiusd::radlog(L_DBG, "sub authenticate smtp=$smtp");
        my $auth_ok = $smtp->auth($username, $password);
        &radiusd::radlog(L_DBG, "sub authenticate auth_ok=$auth_ok");
        $smtp->quit();

        if ($auth_ok) {
                &radiusd::radlog(L_AUTH, "sub authenticate says OK for $username");
                # Accept user and set some attribute
# https://kb.meraki.com/knowledge_base/supported-radius-authentication-protocols-and-attributes-for-wireless
                $RAD_REPLY{'Session-Timeout'} = '86400';
                $RAD_REPLY{'Idle-Timeout'} = '86400';
                $RAD_REPLY{'Reply-Message'} = 'Welcome to the VPN';
                &radiusd::radlog(L_DBG, "sub authenticate is returning MODULE_OK");
                return RLM_MODULE_OK;
        } else {
                &radiusd::radlog(L_ERR, "SMTP AUTH failed for $username");
                # Reject user and tell him why
                $RAD_REPLY{'Reply-Message'} = 'Gmail disagrees with your credentials.';
                return RLM_MODULE_REJECT;
        }
}

# Function to handle preacct
sub preacct {
        &radiusd::radlog(L_DBG, "hello from sub preacct");
        # For debugging purposes only
        &log_request_attributes;

        return RLM_MODULE_OK;
}

# Function to handle accounting
sub accounting {
        &radiusd::radlog(L_DBG, "hello from sub accounting");
        # For debugging purposes only
        &log_request_attributes;

        return RLM_MODULE_OK;
}

# Function to handle checksimul
sub checksimul {
        &radiusd::radlog(L_DBG, "hello from sub checksimul");
        # For debugging purposes only
        &log_request_attributes;

        return RLM_MODULE_OK;
}

# Function to handle pre_proxy
sub pre_proxy {
        &radiusd::radlog(L_DBG, "hello from sub pre_proxy");
        # For debugging purposes only
        &log_request_attributes;

        return RLM_MODULE_OK;
}

# Function to handle post_proxy
sub post_proxy {
        &radiusd::radlog(L_DBG, "hello from sub post_proxy");
        # For debugging purposes only
        &log_request_attributes;

        return RLM_MODULE_OK;
}

# Function to handle post_auth
sub post_auth {
        &radiusd::radlog(L_DBG, "hello from sub post_auth");
        # For debugging purposes only
        &log_request_attributes;

        return RLM_MODULE_OK;
}

# Function to handle xlat
sub xlat {
        &radiusd::radlog(L_DBG, "hello from sub xlat");
        # For debugging purposes only
        &log_request_attributes;

        # Loads some external perl and evaluate it
        my ($filename,$a,$b,$c,$d) = @_;
        &radiusd::radlog(L_DBG, "From xlat filename = $filename ");
        &radiusd::radlog(L_DBG, "From xlat (a,b,c,d) = $a $b $c $d ");
        local *FH;
        open FH, $filename or die "open '$filename' $!";
        local($/) = undef;
        my $sub = <FH>;
        close FH;
        my $eval = qq{ sub handler{ $sub;} };
        eval $eval;
        eval {main->handler;};
}

# Function to handle detach
sub detach {
        &radiusd::radlog(L_DBG, "hello from sub detach");
        # For debugging purposes only
        &log_request_attributes;

        # Do some logging.
        &radiusd::radlog(L_DBG, "Detaching. Reloading. Done.");
}

sub log_request_attributes {
        # This shouldn't be done in production environments!
        # This is only meant for debugging!
        for (keys %RAD_REQUEST) {
                # sanitize these from the logs
                next if /User-Password/;
                &radiusd::radlog(L_DBG, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");
        }
        for (keys %RAD_REPLY) {
                &radiusd::radlog(L_DBG, "RAD_REPLY: $_ = $RAD_REPLY{$_}");
        }
        for (keys %RAD_CHECK) {
                &radiusd::radlog(L_DBG, "RAD_CHECK: $_ = $RAD_CHECK{$_}");
        }
        &radiusd::radlog(L_DBG, "finished running log_request_attributes");
}

sites-enabled_default-domain.conf

server default {
  listen {
    type = auth
    ipaddr = *
    port = 0
    limit {
      max_connections = 0
      lifetime = 0
      idle_timeout = 30
    }
  }

  authorize {
    preprocess
    auth_log
    perl {
      ok = return
    }
    reject
  }

  authenticate {
    Auth-Type perl {
      perl {
        ok = return
      }
    }
    reject
  }

  post-auth {
    reply_log
    Post-Auth-Type Reject {
      update reply {
        &Reply-Message = 'This is only an example.'
      }
    }
  }
}