73 lines
1.9 KiB
Perl
73 lines
1.9 KiB
Perl
#!/usr/bin/perl
|
|
|
|
# Test packet dumping
|
|
|
|
# $Id: dump.t 38 2006-11-14 01:46:05Z lem $
|
|
|
|
|
|
no utf8;
|
|
use IO::File;
|
|
use Test::More tests => 257;
|
|
use Net::Radius::Packet;
|
|
use Net::Radius::Dictionary;
|
|
|
|
# Init the dictionary for our test run...
|
|
BEGIN {
|
|
my $fh = new IO::File "dict.$$", ">";
|
|
print $fh <<EOF;
|
|
ATTRIBUTE User-Name 1 string
|
|
ATTRIBUTE User-Password 2 string
|
|
ATTRIBUTE NAS-IP-Address 4 ipaddr
|
|
EOF
|
|
|
|
close $fh;
|
|
};
|
|
|
|
END { unlink 'dict.' . $$; }
|
|
|
|
# Build a request and test it is ok
|
|
my $p = new Net::Radius::Packet;
|
|
isa_ok($p, 'Net::Radius::Packet');
|
|
$p->set_dict("dict.$$");
|
|
$p->set_code("Access-Request");
|
|
$p->set_attr("User-Name" => 'FOO@MY.DOMAIN');
|
|
$p->set_attr("NAS-IP-Address" => "127.0.0.1");
|
|
my $str;
|
|
|
|
# Really special chars
|
|
for my $c (0 .. 31, 127..255)
|
|
{
|
|
$p->set_authenticator(substr("Char-" . chr($c) . "\x0" x 16, 0, 16));
|
|
$str = $p->str_dump;
|
|
my $re = sprintf('(?m)^Authentic:\s+Char-\\\\x\{%x\}(?:\\\\x\{0\})+$', $c);
|
|
like($str, qr/$re/, "Correct dump of chr($c)");
|
|
}
|
|
|
|
# Really normal chars
|
|
for my $c (32..35, 44..45, 47 .. 62, 64 .. 90, 95, 97..122, 124)
|
|
{
|
|
$p->set_authenticator(substr("Char-" . chr($c) . "\x0" x 16, 0, 16));
|
|
$str = $p->str_dump;
|
|
my $re = sprintf('(?m)^Authentic:\s+Char-%s(?:\\\\x\{0\})+$', chr($c));
|
|
like($str, qr/$re/, "Correct dump of chr($c)");
|
|
}
|
|
|
|
# Things that mean something special to Perl
|
|
for my $c (42, 43, 46, 63)
|
|
{
|
|
$p->set_authenticator(substr("Char-" . chr($c) . "\x0" x 16, 0, 16));
|
|
$str = $p->str_dump;
|
|
my $re = sprintf('(?m)^Authentic:\s+Char-\\%s(?:\\\\x\{0\})+$', chr($c));
|
|
like($str, qr/$re/, "Correct dump of chr($c)");
|
|
}
|
|
|
|
# Quote-like things
|
|
for my $c (36..41, 91..94, 96, 123..125)
|
|
{
|
|
$p->set_authenticator(substr("Char-" . chr($c) . "\x0" x 16, 0, 16));
|
|
$str = $p->str_dump;
|
|
my $re = sprintf('(?m)^Authentic:\s+Char-\\\\\\%s(?:\\\\x\{0\})+$',
|
|
chr($c));
|
|
like($str, qr/$re/, "Correct dump of chr($c)");
|
|
}
|