<div dir="ltr"><div>Hi</div><div><br></div><div>I'm trying to move my freeradius 2.2 configuration to new installed 3.0.1. All seem to work but perl clean up some attributes empty.</div><div><br></div><div>This is my test perl script</div>
<div><div><br></div><div>use strict;</div><div>use warnings;</div><div><br></div><div># use ...</div><div>use Data::Dumper;</div><div>use DBI; Â Â Â Â Â Â Â Â Â Â Â Â # mysql information base</div><div><br></div><div><br></div>
<div>#                               </div><div># Configuration parameters                   </div><div>                               </div><div>
use constant {</div><div>Â Â DEBUG<span class="" style="white-space:pre"> </span>=> '1',<span class="" style="white-space:pre"> </span># for debuggin</div><div>Â Â #</div><div>Â Â # database parameters</div><div>
  DB_HOSTNAME => '<a href="http://db.example.com">db.example.com</a>',   </div><div>  DB_NAME   => 'radius',</div><div>  DB_USER   => 'radius',       </div><div>  DB_PASS   => 'secret'</div>
<div>}; Â Â Â Â Â Â Â Â Â Â Â </div><div><br></div><div># Bring the global hashes into the package scope</div><div>our (%RAD_REQUEST, %RAD_REPLY, %RAD_CHECK);</div><div><br></div><div>#</div><div># This the remapping of return values</div>
<div>#</div><div>use constant {</div><div><br></div><div><span class="" style="white-space:pre"> </span>RLM_MODULE_REJECT<span class="" style="white-space:pre"> </span>=> 0, # Â /* immediately reject the request */</div>
<div><span class="" style="white-space:pre"> </span>RLM_MODULE_FAIL<span class="" style="white-space:pre"> </span>=> 1, # Â /* module failed, don't reply */</div><div><span class="" style="white-space:pre"> </span>RLM_MODULE_OK<span class="" style="white-space:pre"> </span>=> 2, # Â /* the module is OK, continue */</div>
<div><span class="" style="white-space:pre"> </span>RLM_MODULE_HANDLED<span class="" style="white-space:pre"> </span>=> 3, # Â /* the module handled the request, so stop. */</div><div><span class="" style="white-space:pre"> </span>RLM_MODULE_INVALID<span class="" style="white-space:pre"> </span>=> 4, # Â /* the module considers the request invalid. */</div>
<div><span class="" style="white-space:pre"> </span>RLM_MODULE_USERLOCK<span class="" style="white-space:pre"> </span>=> 5, # Â /* reject the request (user is locked out) */</div><div><span class="" style="white-space:pre"> </span>RLM_MODULE_NOTFOUND<span class="" style="white-space:pre"> </span>=> 6, # Â /* user not found */</div>
<div><span class="" style="white-space:pre"> </span>RLM_MODULE_NOOP<span class="" style="white-space:pre"> </span>=> 7, # Â /* module succeeded without doing anything */</div><div><span class="" style="white-space:pre"> </span>RLM_MODULE_UPDATED<span class="" style="white-space:pre"> </span>=> 8, # Â /* OK (pairs modified) */</div>
<div><span class="" style="white-space:pre"> </span>RLM_MODULE_NUMCODES<span class="" style="white-space:pre"> </span>=> 9, # Â /* How many return codes there are */</div><div><br></div><div><span class="" style="white-space:pre"> </span># Same as src/include/radiusd.h</div>
<div><span class="" style="white-space:pre"> </span> Â Â L_DBG<span class="" style="white-space:pre"> </span>=> 1,</div><div><span class="" style="white-space:pre"> </span> Â Â L_AUTH<span class="" style="white-space:pre"> </span>=> 2,</div>
<div><span class="" style="white-space:pre"> </span> Â Â L_INFO<span class="" style="white-space:pre"> </span>=> 3,</div><div><span class="" style="white-space:pre"> </span> Â Â L_ERR<span class="" style="white-space:pre"> </span>=> 4,</div>
<div><span class="" style="white-space:pre"> </span> Â Â L_PROXY<span class="" style="white-space:pre"> </span>=> 5,</div><div><span class="" style="white-space:pre"> </span> Â Â L_ACCT<span class="" style="white-space:pre"> </span>=> 6</div>
<div>};</div><div><br></div><div><br></div><div>our $dbh;</div><div><br></div><div># Connecting datebase</div><div>sub CLONE {</div><div>Â Â $dbh = DBI->connect("dbi:mysql:dbname=".DB_NAME.";host=".DB_HOSTNAME,DB_USER,DB_PASS,{PrintError => 0})</div>
<div>Â Â or &radiusd::radlog(L_DBG, "DEBUG post_auth: DBI error: ".$DBI::errstr); Â Â Â Â Â Â Â Â </div><div>Â Â if (!defined($dbh)) {</div><div>Â Â Â Â &err_out;</div><div>Â Â Â Â &radiusd::radlog(L_ERR, "can't connect to database!"); Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â </div>
<div>Â Â Â Â $RAD_REPLY {'Reply-Message'} = "Internal server error";</div><div>Â Â Â Â return RLM_MODULE_FAIL; Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â </div><div>Â Â }</div><div>}</div><div><br></div><div>sub authorize {</div>
<div>Â Â print Dumper (%RAD_REQUEST);</div><div>Â Â return RLM_MODULE_OK;</div><div>}</div></div><div><br></div><div><br></div><div>And the radius -X output</div><div>This one without perl script</div><div><div>Ready to process requests.</div>
<div>rad_recv: Access-Request packet from host 192.168.20.240 port 1812, id=62, length=205</div><div>Â Â User-Name = 'test_jur'</div><div>Â Â CHAP-Password = 0x01cc75f2ddb427d70</div><div>Â Â CHAP-Challenge = 0xea55985e715e3e1f</div>
<div>Â Â Service-Type = Framed-User</div><div>Â Â Framed-Protocol = PPP</div><div>Â Â NAS-Identifier = 'test-se600'</div><div>Â Â NAS-Port = 50462720</div><div>Â Â NAS-Real-Port = 838860811</div><div>Â Â NAS-Port-Type = Virtual</div>
<div>Â Â NAS-Port-Id = '3/2 vlan-id 11 pppoe 60'</div><div>Â Â Medium-Type = DSL</div><div>Â Â Mac-Addr = '00-50-56-84-69-59'</div><div>Â Â Platform-Type = SE-600</div><div>Â Â OS-Version = '12.1.1.5'</div>
<div>(5) # Executing section authorize from file /usr/local/etc/raddb/sites-available/pppoe</div><div>(5) Â authorize {</div><div>(5) Â filter_username filter_username {</div><div>(5) Â Â ? if (!User-Name)</div><div>(5) Â Â ? if (!User-Name) -> FALSE</div>
<div>(5) Â Â ? if (User-Name =~ /([0-9A-F]{2}[:-]){5}([0-9A-F]{2})$/)Â </div><div>(5) Â Â ? if (User-Name =~ /([0-9A-F]{2}[:-]){5}([0-9A-F]{2})$/) Â -> FALSE</div><div>(5) Â Â ? if (User-Name == 'Redback')</div><div>
(5) Â Â ? if (User-Name == 'Redback') -> FALSE</div><div>(5) Â Â ? if (User-Name =~ / /)Â </div><div>(5) Â Â ? if (User-Name =~ / /) Â -> FALSE</div><div>(5) Â Â ? if (User-Name =~ /@.*@/ )Â </div><div>(5) Â Â ? if (User-Name =~ /@.*@/ ) Â -> FALSE</div>
<div>(5) Â Â ? if (User-Name =~ /\\.\\./ )Â </div><div>(5) Â Â ? if (User-Name =~ /\\.\\./ ) Â -> FALSE</div><div>(5) Â Â ? if (User-Name =~ /\\.$/) Â </div><div>(5) Â Â ? if (User-Name =~ /\\.$/) Â -> FALSE</div><div>(5) Â Â ? if (User-Name =~ /@\\./) Â </div>
<div>(5) Â Â ? if (User-Name =~ /@\\./) Â -> FALSE</div><div>(5) Â } # filter_username filter_username = notfound</div><div>(5) Â [preprocess] = ok</div><div>(5) Â ? if (OS-Version == '12.1.1.5')Â </div><div>(5) Â ? if (OS-Version == '12.1.1.5') Â -> TRUE</div>
<div>(5) Â if (OS-Version == '12.1.1.5') Â { ... } # empty sub-section is ignored</div></div><div>.....</div><div><br></div><div>And this one with perl</div><div><div>rad_recv: Access-Request packet from host 192.168.20.240 port 1812, id=60, length=205</div>
<div>Â Â User-Name = 'test_jur'</div><div>Â Â CHAP-Password = 0x016dbecc2a777</div><div>Â Â CHAP-Challenge = 0xec96dfb8b8af</div><div>Â Â Service-Type = Framed-User</div><div>Â Â Framed-Protocol = PPP</div><div>Â Â NAS-Identifier = 'test-se600'</div>
<div>Â Â NAS-Port = 50462720</div><div>Â Â NAS-Real-Port = 838860811</div><div>Â Â NAS-Port-Type = Virtual</div><div>Â Â NAS-Port-Id = '3/2 vlan-id 11 pppoe 58'</div><div>Â Â Medium-Type = DSL</div><div>Â Â Mac-Addr = '00-50-56-84-69-59'</div>
<div>Â Â Platform-Type = SE-600</div><div>Â Â OS-Version = '12.1.1.5'</div><div>(0) # Executing section authorize from file /usr/local/etc/raddb/sites-available/pppoe</div><div>(0) Â authorize {</div><div>$VAR1 = 'OS-Version';</div>
<div>$VAR2 = '';</div><div>$VAR3 = 'NAS-Port-Type';</div><div>$VAR4 = 'Virtual';</div><div>$VAR5 = 'NAS-Real-Port';</div><div>$VAR6 = '838860811';</div><div>$VAR7 = 'CHAP-Password';</div>
<div>$VAR8 = '0x016dbecc2a777';</div><div>$VAR9 = 'Service-Type';</div><div>$VAR10 = 'Framed-User';</div><div>$VAR11 = 'Medium-Type';</div><div>$VAR12 = 'DSL';</div><div>$VAR13 = 'Framed-Protocol';</div>
<div>$VAR14 = 'PPP';</div><div>$VAR15 = 'User-Name';</div><div>$VAR16 = '';</div><div>$VAR17 = 'CHAP-Challenge';</div><div>$VAR18 = '0xec96dfb8b8af';</div><div>$VAR19 = 'NAS-Identifier';</div>
<div>$VAR20 = '';</div><div>$VAR21 = 'Platform-Type';</div><div>$VAR22 = 'SE-600';</div><div>$VAR23 = 'NAS-Port';</div><div>$VAR24 = '50462720';</div><div>$VAR25 = 'Mac-Addr';</div>
<div>$VAR26 = '';</div><div>$VAR27 = 'NAS-Port-Id';</div><div>$VAR28 = '';</div><div>rlm_perl: Added pair OS-Version =Â </div><div>rlm_perl: Added pair NAS-Port-Type = Virtual</div><div>rlm_perl: Added pair NAS-Real-Port = 838860811</div>
<div>rlm_perl: Added pair CHAP-Password = 0x016dbecc2a777</div><div>rlm_perl: Added pair Service-Type = Framed-User</div><div>rlm_perl: Added pair Medium-Type = DSL</div><div>rlm_perl: Added pair Framed-Protocol = PPP</div>
<div>rlm_perl: Added pair User-Name =Â </div><div>rlm_perl: Added pair CHAP-Challenge = 0xec96dfb8b8af</div><div>rlm_perl: Added pair NAS-Identifier =Â </div><div>rlm_perl: Added pair Platform-Type = SE-600</div><div>rlm_perl: Added pair NAS-Port = 50462720</div>
<div>rlm_perl: Added pair Mac-Addr =Â </div><div>rlm_perl: Added pair NAS-Port-Id =Â </div><div>(0) Â [perl_pppoe] = ok</div><div>(0) Â filter_username filter_username {</div><div>(0) Â Â ? if (!User-Name)</div><div>(0) Â Â ? if (!User-Name) -> FALSE</div>
<div>(0) Â Â ? if (User-Name =~ /([0-9A-F]{2}[:-]){5}([0-9A-F]{2})$/)Â </div><div>(0) Â Â ? if (User-Name =~ /([0-9A-F]{2}[:-]){5}([0-9A-F]{2})$/) Â -> FALSE</div><div>(0) Â Â ? if (User-Name == 'Redback')</div><div>
(0) Â Â ? if (User-Name == 'Redback') -> FALSE</div><div>(0) Â Â ? if (User-Name =~ / /)Â </div><div>(0) Â Â ? if (User-Name =~ / /) Â -> FALSE</div><div>(0) Â Â ? if (User-Name =~ /@.*@/ )Â </div><div>(0) Â Â ? if (User-Name =~ /@.*@/ ) Â -> FALSE</div>
<div>(0) Â Â ? if (User-Name =~ /\\.\\./ )Â </div><div>(0) Â Â ? if (User-Name =~ /\\.\\./ ) Â -> FALSE</div><div>(0) Â Â ? if (User-Name =~ /\\.$/) Â </div><div>(0) Â Â ? if (User-Name =~ /\\.$/) Â -> FALSE</div><div>(0) Â Â ? if (User-Name =~ /@\\./) Â </div>
<div>(0) Â Â ? if (User-Name =~ /@\\./) Â -> FALSE</div><div>(0) Â } # filter_username filter_username = ok</div><div>(0) Â [preprocess] = ok</div><div>(0) Â ? if (OS-Version == '12.1.1.5')Â </div><div>(0) Â ? if (OS-Version == '12.1.1.5') Â -> FALSE</div>
</div><div>....</div><div><br></div><div><br></div><div><div>As you can see in the second -X output perl cleared some attributes:</div><div>OS-Version (which I tested with if statement after perl)</div><div>User-Name</div>
<div>NAS-Identifier</div><div>Mac-Addr</div><div>NAS-Port-Id</div><div><br></div><div>Why is it so? Did I do something wrong or it's a perl bug?</div></div><div><br></div><div>P.S. In 2.2 this perl script work fine.<br>
</div><div><br></div><div><div dir="ltr"><font><i>Regards,</i></font><div><font><i>Alexander.</i></font></div></div></div>
</div>