SV: perl examples

[Alexander Silveröhrt]

Since i was just in the making of some hooks using DBI I took some time to copy paste something that could be something towards the thing you wanted?
This is just an example so don't take it to serious..

I also don't think you should do it as post_auth hook but a authorize hook so

Don't forget to add module = /etc/freeradius/myscript.pl and uncomment  #func_authorize = authorize ANDS/OR #func_post_auth = post_auth in modules/perl

And add perl and sql tp your default
vi sites-enabled/default

authorize {
        preprocess
        perl    ## <---
        auth_log
        sql             ## <---
        expiration
        logintime
}


## Example myscript.pl script ##
#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;
use DBI;
use Data::Dumper;

### Radius HASH Tables ###
our (%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 authorize{

        ################################
            ###  DB Connection variables ###
        ################################
        our ($driver) = "mysql";

        our ($user) = "dbuser";
        our ($pw) = "mypassword";

        our ($database) = "radius";
        our ($host) = "localhost:3306";

        our $dsn = "DBI:$driver:$database:$host";

        ## For good manners you should add something here that only makes the db connect if code eq "Access-Request" or something something...
        our $dbh = DBI->connect ($dsn, $user, $pw, { RaiseError => 1 });

        our $sth;

        ### Other variables ###
        my $NAS_IP_ADDRESS = $RAD_REQUEST{'NAS-IP-Address'};
        my $CALLING_STATION_ID = $RAD_REQUEST{'Calling-Station-Id'};
        my $NAS_PORT_ID = $RAD_REQUEST{'NAS-Port-Id'};
        my $USER_NAME = $RAD_REQUEST{'User-Name'};
        my $MAC = $RAD_REQUEST{'some-Client-Hardware-Addr'};
        my $VENDOR_ID = $RAD_REQUEST{'some-DHCP-Vendor-Class-Id'};
        if (!$VENDOR_ID)
        {
                $RAD_REQUEST{'some-DHCP-Vendor-Class-Id'} = "NO_VENDOR_ID";
        }
        ### ETC ETC...

        $sth = $dbh->prepare("SELECT vlan FROM my_vlan_table WHERE NAS_IP_ADDRESS = '$NAS_IP_ADDRESS' AND CALLING_STATION_ID = '$CALLING_STATION_ID'");   ## <-- Or something.
        $sth->execute ();

        my $VLAN = $sth->fetchrow_array();
        $sth->finish ();

        if (!$VLAN)
        {
                ### SOmething something
                ### Or maybe a default account..
                $RAD_REQUEST{'User-Name'} = "my_default_user_account";
                $RAD_REPLY{'Auth-Type'} = "Accept";
                $RAD_REPLY{'User-Name'} = "$USER_NAME";
                $RAD_REPLY{'needed-reply-attribute-Subsc-ID-Str'} = "$MAC";
                $RAD_REPLY{'needed-reply-attribute-Subsc-Prof-Str'} = "direct_access";
                $RAD_REPLY{'needed-reply-attribute-SLA-Prof-Str'} = "150-BB-10-10";
                ### ETC ETC...


        }
        else
        {
                $RAD_REPLY{'vlan-id-attribute-to-send-back'} = "$VLAN";
                $RAD_REPLY{'Auth-Type'} = "Accept";
                $RAD_REPLY{'User-Name'} = "$USER_NAME";
                $RAD_REPLY{'needed-reply-attribute-Subsc-ID-Str'} = "$MAC";
                $RAD_REPLY{'needed-reply-attribute-Subsc-Prof-Str'} = "direct_access";
                $RAD_REPLY{'needed-reply-attribute-SLA-Prof-Str'} = "150-BB-10-10";

        }

        $dbh->disconnect ();

        return RLM_MODULE_OK;
}
-----Ursprungligt meddelande-----
Från: freeradius-users-bounces+alexander.silverohrt=itux.se at lists.freeradius.org [mailto:freeradius-users-bounces+alexander.silverohrt=itux.se at lists.freeradius.org] För Alex Sharaz
Skickat: den 8 april 2013 13:37
Till: FreeRadius users mailing list
Ämne: perl examples

Hi,
There don't seem to be many examples relating to using  perl to access remote databases.... in fact there don't seem to be many perl examples at all.

Got example.pl configured a wee bit and running on test server but could do with a better db related example.

Unfortunately my perl skills aren't ts good as they could be.

In post-auth I want to

extract the nas-ip address and calling station-id of the client device
open a db connection and perform a query that'll let me  decide what vlan-id to send back in the access-accept packet
write radius attributes into the access-accept reply

Anyone got some form of template I could use for the above?
Rgds
Alex


-
List info/subscribe/unsubscribe? See http://www.freeradius.org/list/users.html

********* DISCLAIMER *********

This message and any attachment are confidential and may be privileged or otherwise protected from disclosure and may include proprietary information. If you are not the intended recipient, please telephone or email the sender and delete this message and any attachment from your system. If you are not the intended recipient you must not copy this message or attachment or disclose the contents to any other person