Viewing file: 
ber-test.pl (6.12 KB) -rwxr-xr-xSelect action/file-type:
(
+) |
(
+) |
(
+) |
Code (
+) |
Session (
+) |
(
+) |
SDB (
+) |
(
+) |
(
+) |
(
+) |
(
+) |
(
+) |
#!/usr/bin/perl -w
######################################################################
### Name: ber-test.pl
### Date Created: Sat Feb 1 16:09:46 1997
### Author: Simon Leinen <simon@switch.ch>
### RCS $Id: ber-test.pl,v 1.9 2004-02-17 21:38:56 leinen Exp $
######################################################################
### Regression Tests for BER encoding/decoding
######################################################################
use BER;
use Carp;
use integer;
use strict;
## Prototypes
sub regression_test ();
sub encode_int_test ($$);
sub decode_intlike_test ($$);
sub eq_test ($$);
sub equal_test ($$);
sub string_hex ($ );
sub encode_int_regression_test ();
my $exitcode = 0;
regression_test;
exit ($exitcode);
#### Regression Tests
sub regression_test ()
{
eq_test ('encode_string ("public")', "\x04\x06\x70\x75\x62\x6C\x69\x63");
eq_test ('encode_ip_address ("\x82\x3b\x04\x02")', "\x40\x04\x82\x3b\x04\x02");
eq_test ('encode_ip_address ("130.59.4.2")', "\x40\x04\x82\x3b\x04\x02");
encode_int_test (0x4aec3116, "\x02\x04\x4A\xEC\x31\x16");
encode_int_test (0xec3116, "\x02\x04\x00\xEC\x31\x16");
encode_int_test (0x3c3116, "\x02\x03\x3C\x31\x16");
encode_int_test (-1234, "\x02\x02\xfb\x2e");
decode_intlike_test ('"\x02\x01\x01"', 1);
decode_intlike_test ('"\x02\x01\xff"', -1);
decode_intlike_test ('"\x02\x02\x01\x02"', 258);
decode_intlike_test ('"\x02\x02\xff\xff"', -1);
decode_intlike_test ('"\x02\x03\x00\xff\xfe"', 65534);
decode_intlike_test ('"\x02\x03\xff\xff\xfd"', -3);
decode_intlike_test ('"\x02\x04\x00\xff\xff\xfd"', 16777213);
decode_intlike_test ('"\x02\x04\xff\xff\xff\xfc"', -4);
decode_intlike_test ('"\x02\x05\x00\xff\xff\xff\xfc"', 4294967292);
## Tests for integers > 2^32
##
## For really big integers (those that don't have an exact double
## representation, I guess), we have to write the comparands as
## strings, because otherwise they will be converted to NaN by
## Perl. The comparisons still work right thanks to Math::BigInt,
## which is used by BER.pm for large integers.
##
decode_intlike_test ('"\x02\x06\x00\x01\x00\x00\x00\x00"', 4294967296);
decode_intlike_test ('"\x02\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff"',
"18446744073709551615");
use Math::BigInt lib => 'GMP';
{
## We have to disable warnings because of Math::BigInt
##
local $^W = 0;
eq_test ('encode_int (new Math::BigInt ("18446744073709551615"))',
"\x02\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff");
}
eq_test ('(BER::decode_string ("\x04\x06public"))[0]', "public");
eq_test ('(BER::decode_oid ("\x06\x04\x01\x03\x06\x01"))[0]',
"\x06\x04\x01\x03\x06\x01");
die unless encode_int_regression_test ();
}
sub encode_int_test ($$) {
my ($int, $encoded) = @_;
eq_test ("encode_int ($int)", $encoded);
}
sub decode_intlike_test ($$) {
my ($pdu, $wanted) = @_;
equal_test ("(BER::decode_intlike ($pdu))[0]", $wanted);
}
sub eq_test ($$) {
my ($expr, $wanted) = @_;
my $result;
undef $@;
$result = eval $expr;
croak "$@" if $@;
(warn $expr." => ".string_hex ($result)." != ".string_hex ($wanted)), ++$exitcode
unless $result eq $wanted;
}
sub equal_test ($$) {
my ($expr, $wanted) = @_;
my $result;
undef $@;
$result = eval $expr;
croak "$@" if $@;
(warn $expr." => ".$result." != ".$wanted), ++$exitcode
unless $result == $wanted;
}
sub string_hex ($ ) {
my $result = '';
my ($string) = @_;
my ($i);
for ($i = 0; $i < length $string; ++$i) {
$result .= sprintf "%02x", ord (substr ($string, $i, 1));
}
$result;
}
### Test cases and harness kindly contributed by
### Mike Mitchell <mcm@unx.sas.com>
###
sub encode_int_regression_test () {
my $try;
my @tries = (
0, 1, 126, 127, 128, 129, 254, 255, 256, 257, 32766, 32767,
32768, 32769, 65534, 65535, 65536, 65537, 8388606, 8388607,
8388608, 8388609, 16777214, 16777215, 16777216, 16777217,
-1, -126, -127, -128, -129, -254, -255, -256, -257, -32766, -32767,
-32768, -32769, -65534, -65535, -65536, -65537, -8388606, -8388607,
-8388608, -8388609, -16777214, -16777215, -16777216, -16777217,
5921370, -5921370, 2147483646, 2147483647, -2147483647, -2147483648
);
my $expected = <<EOM;
0: 02 01 00
1: 02 01 01
126: 02 01 7e
127: 02 01 7f
128: 02 02 00 80
129: 02 02 00 81
254: 02 02 00 fe
255: 02 02 00 ff
256: 02 02 01 00
257: 02 02 01 01
32766: 02 02 7f fe
32767: 02 02 7f ff
32768: 02 03 00 80 00
32769: 02 03 00 80 01
65534: 02 03 00 ff fe
65535: 02 03 00 ff ff
65536: 02 03 01 00 00
65537: 02 03 01 00 01
8388606: 02 03 7f ff fe
8388607: 02 03 7f ff ff
8388608: 02 04 00 80 00 00
8388609: 02 04 00 80 00 01
16777214: 02 04 00 ff ff fe
16777215: 02 04 00 ff ff ff
16777216: 02 04 01 00 00 00
16777217: 02 04 01 00 00 01
-1: 02 01 ff
-126: 02 01 82
-127: 02 01 81
-128: 02 01 80
-129: 02 02 ff 7f
-254: 02 02 ff 02
-255: 02 02 ff 01
-256: 02 02 ff 00
-257: 02 02 fe ff
-32766: 02 02 80 02
-32767: 02 02 80 01
-32768: 02 02 80 00
-32769: 02 03 ff 7f ff
-65534: 02 03 ff 00 02
-65535: 02 03 ff 00 01
-65536: 02 03 ff 00 00
-65537: 02 03 fe ff ff
-8388606: 02 03 80 00 02
-8388607: 02 03 80 00 01
-8388608: 02 03 80 00 00
-8388609: 02 04 ff 7f ff ff
-16777214: 02 04 ff 00 00 02
-16777215: 02 04 ff 00 00 01
-16777216: 02 04 ff 00 00 00
-16777217: 02 04 fe ff ff ff
5921370: 02 03 5a 5a 5a
-5921370: 02 03 a5 a5 a6
2147483646: 02 04 7f ff ff fe
2147483647: 02 04 7f ff ff ff
-2147483647: 02 04 80 00 00 01
-2147483648: 02 04 80 00 00 00
EOM
my @wanted = split ("\n", $expected);
foreach $try (@tries) {
my ($r, $jnk, $val, @vals, $output, $wanted);
undef @vals;
$r = BER::encode_int($try);
$output = "$try: ";
@vals = unpack("C*", $r);
foreach $val (@vals)
{
$output .= sprintf ("%02x ", $val);
}
($r, $jnk) = BER::decode_intlike_s($r, 1);
$output .= "Decode to $r didn't match!" if ($r != $try);
$wanted = shift @wanted;
die "Mismatch in encode_int_regression_test:\n"
."< $wanted\n> $output" unless $output eq $wanted;
}
1;
}
