%PDF-
%PDF-
Mini Shell
Mini Shell
# $Id: 05-TSIG.t 1561 2017-04-19 13:08:13Z willem $ -*-perl-*-
#
use strict;
use Test::More;
use Net::DNS;
my @prerequisite = qw(
Digest::HMAC
Digest::MD5
Digest::SHA
MIME::Base64
);
foreach my $package (@prerequisite) {
next if eval "use $package; 1;";
plan skip_all => "$package not installed";
exit;
}
plan tests => 68;
sub mysign {
my ( $key, $data ) = @_;
my $hmac = new Digest::HMAC( $key, 'Digest::MD5' );
$hmac->add($data);
return $hmac->digest;
}
my $name = '123456789-test';
my $type = 'TSIG';
my $code = 250;
my @attr = qw( algorithm time_signed fudge sig_function );
my @data = ( qw( fake.alg 100001 600 ), \&mysign );
my @also = qw( mac prior_mac request_mac error sign_func other_data _size );
my $wire = '0466616b6503616c67000000000186a102580010a5d31d3ce3b7122b4a598c225d9c3f2a04d200000000';
my $hash = {};
@{$hash}{@attr} = @data;
{
my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode;
is( $typecode, $code, "$type RR type code = $code" );
my $rr = new Net::DNS::RR(
name => $name,
type => $type,
%$hash,
keybin => pack( 'H*', '66616b65206b6579' ),
);
my $string = $rr->string;
like( $rr->string, "/$$hash{algorithm}/", 'got expected rr->string' );
foreach (@attr) {
is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" );
}
foreach (@also) {
ok( defined $rr->$_, "additional attribute rr->$_()" );
}
my $null = new Net::DNS::RR("$name NULL")->encode;
my $empty = new Net::DNS::RR("$name $type")->encode;
my $buffer = $empty; ## Note: TSIG RR gets destroyed by decoder
my $rxbin = decode Net::DNS::RR( \$buffer )->encode;
my $packet = Net::DNS::Packet->new( $name, 'TKEY', 'IN' );
$packet->header->id(1234); # fix packet id
$packet->header->rd(1);
my $encoded = $buffer = $rr->encode( 0, {}, $packet );
my $decoded = decode Net::DNS::RR( \$buffer );
my $hex1 = unpack 'H*', $encoded;
my $hex2 = unpack 'H*', $decoded->encode;
my $hex3 = unpack 'H*', substr( $encoded, length $null );
is( $hex2, $hex1, 'encode/decode transparent' );
is( $hex3, $wire, 'encoded RDATA matches example' );
is( length($empty), length($null), 'encoded RDATA can be empty' );
is( length($rxbin), length($null), 'decoded RDATA can be empty' );
my @wire = unpack 'C*', $encoded;
my $wireformat = pack 'C*', @wire, 0;
eval { decode Net::DNS::RR( \$wireformat ); };
my $exception = $1 if $@ =~ /^(.+)\n/;
ok( $exception ||= '', "misplaced SIG RR\t[$exception]" );
}
{
my $rr = new Net::DNS::RR( type => 'TSIG', key => '' );
ok( !$rr->verify(), 'verify fails on empty TSIG' );
ok( $rr->vrfyerrstr(), 'vrfyerrstr() reports failure' );
ok( !$rr->other(), 'other undefined' );
ok( $rr->time_signed(), 'time_signed() defined' );
my $key = eval { $rr->key(); };
my $exception = $1 if $@ =~ /^(.+)\n/;
ok( $exception ||= '', "write-only key attribute\t[$exception]" );
}
{
my $correct = '123456789ABCDEF';
my $corrupt = '123456789XBCDEF';
foreach my $method (qw(mac request_mac prior_mac)) {
my $rr = new Net::DNS::RR( type => 'TSIG', $method => $correct );
ok( $rr->$method($correct), "correct hex $method" );
eval { $rr->$method($corrupt); };
my $exception = $1 if $@ =~ /^(.+)\n/;
ok( $exception ||= '', "corrupt hex $method\t[$exception]" );
}
}
{
# Check default signing function using test cases from RFC2202, section 2.
my $tsig = new Net::DNS::RR( type => 'TSIG', fudge => 300 );
my $function = $tsig->sig_function; # default signing function
my $algorithm = $tsig->algorithm; # default algorithm
is( $algorithm, 'HMAC-MD5.SIG-ALG.REG.INT', 'Check algorithm correctly identified' );
{
my $data = pack 'H*', '4869205468657265';
my $key = "\x0b" x 16;
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = '9294727a3638bb1c13f48ef8158bfc9d';
is( $result, $expect, "Check signing function for $algorithm" );
}
{
my $data = pack 'H*', '7768617420646f2079612077616e7420666f72206e6f7468696e673f';
my $key = pack 'H*', '4a656665';
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = '750c783e6ab0b503eaa86e310a5db738';
is( $result, $expect, "Check $algorithm with key shorter than hash size" );
}
{
my $data = "\xdd" x 50;
my $key = "\xaa" x 16;
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = '56be34521d144c88dbb8c733f0e8b3f6';
is( $result, $expect, "Check $algorithm with data longer than hash size" );
}
{
my $data = "\xcd" x 50;
my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819';
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = '697eaf0aca3a3aea3a75164746ffaa79';
is( $result, $expect, "Check $algorithm with key and data longer than hash" );
}
{
my $data = pack 'H*', join '', qw(
54657374205573696e67204c61726765
72205468616e20426c6f636b2d53697a
65204b6579202d2048617368204b6579
204669727374 );
my $key = "\xaa" x 80;
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = '6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd';
is( $result, $expect, "Check $algorithm with key longer than block size" );
}
{
my $data = pack 'H*', join '', qw(
54657374205573696e67204c61726765
72205468616e20426c6f636b2d53697a
65204b657920616e64204c6172676572
205468616e204f6e6520426c6f636b2d
53697a652044617461 );
my $key = "\xaa" x 80;
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = '6f630fad67cda0ee1fb1f562db3aa53e';
is( $result, $expect, "Check $algorithm with both long key and long data" );
}
}
{
# Check HMAC-SHA1 signing function using test cases from RFC2202, section 3.
my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 'HMAC-SHA' ); # alias HMAC-SHA1
my $algorithm = $tsig->algorithm;
my $function = $tsig->sig_function;
is( $algorithm, 'HMAC-SHA1', 'Check algorithm correctly identified' );
{
my $data = pack 'H*', '4869205468657265';
my $key = "\x0b" x 20;
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = 'b617318655057264e28bc0b6fb378c8ef146be00';
is( $result, $expect, "Check signing function for $algorithm" );
}
{
my $data = pack 'H*', '7768617420646f2079612077616e7420666f72206e6f7468696e673f';
my $key = pack 'H*', '4a656665';
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = 'effcdf6ae5eb2fa2d27416d5f184df9c259a7c79';
is( $result, $expect, "Check $algorithm with key shorter than hash size" );
}
{
my $data = "\xdd" x 50;
my $key = "\xaa" x 20;
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = '125d7342b9ac11cd91a39af48aa17b4f63f175d3';
is( $result, $expect, "Check $algorithm with data longer than hash size" );
}
{
my $data = "\xcd" x 50;
my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819';
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = '4c9007f4026250c6bc8414f9bf50c86c2d7235da';
is( $result, $expect, "Check $algorithm with key and data longer than hash" );
}
{
my $data = pack 'H*', join '', qw(
54657374205573696e67204c61726765
72205468616e20426c6f636b2d53697a
65204b6579202d2048617368204b6579
204669727374 );
my $key = "\xaa" x 80;
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = 'aa4ae5e15272d00e95705637ce8a3b55ed402112';
is( $result, $expect, "Check $algorithm with key longer than block size" );
}
{
my $data = pack 'H*', join '', qw(
54657374205573696e67204c61726765
72205468616e20426c6f636b2d53697a
65204b657920616e64204c6172676572
205468616e204f6e6520426c6f636b2d
53697a652044617461 );
my $key = "\xaa" x 80;
my $result = lc unpack( 'H*', &$function( $key, $data ) );
my $expect = 'e8e99d0f45237d786d6bbaa7965c7808bbff1a91';
is( $result, $expect, "Check $algorithm with both long key and long data" );
}
}
{
# Check HMAC-SHA224 signing function using test cases from RFC4634, section 8.4.
my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 162 ); # alias HMAC-SHA224
my $algorithm = $tsig->algorithm;
my $function = $tsig->sig_function;
is( $algorithm, 'HMAC-SHA224', 'Check algorithm correctly identified' );
{
my $data = pack 'H*', '4869205468657265';
my $key = "\x0b" x 20;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '896FB1128ABBDF196832107CD49DF33F47B4B1169912BA4F53684B22';
is( $result, $expect, "Check signing function for $algorithm" );
}
{
my $data = pack 'H*', '7768617420646f2079612077616e7420666f72206e6f7468696e673f';
my $key = pack 'H*', '4a656665';
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = 'A30E01098BC6DBBF45690F3A7E9E6D0F8BBEA2A39E6148008FD05E44';
is( $result, $expect, "Check $algorithm with key shorter than hash size" );
}
{
my $data = "\xdd" x 50;
my $key = "\xaa" x 20;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '7FB3CB3588C6C1F6FFA9694D7D6AD2649365B0C1F65D69D1EC8333EA';
is( $result, $expect, "Check $algorithm with data longer than hash size" );
}
{
my $data = "\xcd" x 50;
my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819';
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '6C11506874013CAC6A2ABC1BB382627CEC6A90D86EFC012DE7AFEC5A';
is( $result, $expect, "Check $algorithm with key and data longer than hash" );
}
{
my $data = pack 'H*', join '', qw(
54657374205573696e67204c61726765
72205468616e20426c6f636b2d53697a
65204b6579202d2048617368204b6579
204669727374 );
my $key = "\xaa" x 131;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '95E9A0DB962095ADAEBE9B2D6F0DBCE2D499F112F2D2B7273FA6870E';
is( $result, $expect, "Check $algorithm with key longer than block size" );
}
{
my $data = pack 'H*', join '', qw(
54686973206973206120746573742075
73696e672061206c6172676572207468
616e20626c6f636b2d73697a65206b65
7920616e642061206c61726765722074
68616e20626c6f636b2d73697a652064
6174612e20546865206b6579206e6565
647320746f2062652068617368656420
6265666f7265206265696e6720757365
642062792074686520484d414320616c
676f726974686d2e );
my $key = "\xaa" x 131;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '3A854166AC5D9F023F54D517D0B39DBD946770DB9C2B95C9F6F565D1';
is( $result, $expect, "Check $algorithm with both long key and long data" );
}
}
{
# Check HMAC-SHA256 signing function using test cases from RFC4634, section 8.4.
my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 'HMAC-SHA256' );
my $algorithm = $tsig->algorithm;
my $function = $tsig->sig_function;
{
my $data = pack 'H*', '4869205468657265';
my $key = "\x0b" x 20;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = 'B0344C61D8DB38535CA8AFCEAF0BF12B881DC200C9833DA726E9376C2E32CFF7';
is( $result, $expect, "Check signing function for $algorithm" );
}
{
my $data = pack 'H*', '7768617420646f2079612077616e7420666f72206e6f7468696e673f';
my $key = pack 'H*', '4a656665';
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '5BDCC146BF60754E6A042426089575C75A003F089D2739839DEC58B964EC3843';
is( $result, $expect, "Check $algorithm with key shorter than hash size" );
}
{
my $data = "\xdd" x 50;
my $key = "\xaa" x 20;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '773EA91E36800E46854DB8EBD09181A72959098B3EF8C122D9635514CED565FE';
is( $result, $expect, "Check $algorithm with data longer than hash size" );
}
{
my $data = "\xcd" x 50;
my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819';
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '82558A389A443C0EA4CC819899F2083A85F0FAA3E578F8077A2E3FF46729665B';
is( $result, $expect, "Check $algorithm with key and data longer than hash" );
}
{
my $data = pack 'H*', join '', qw(
54657374205573696e67204c61726765
72205468616e20426c6f636b2d53697a
65204b6579202d2048617368204b6579
204669727374 );
my $key = "\xaa" x 131;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '60E431591EE0B67F0D8A26AACBF5B77F8E0BC6213728C5140546040F0EE37F54';
is( $result, $expect, "Check $algorithm with key longer than block size" );
}
{
my $data = pack 'H*', join '', qw(
54686973206973206120746573742075
73696e672061206c6172676572207468
616e20626c6f636b2d73697a65206b65
7920616e642061206c61726765722074
68616e20626c6f636b2d73697a652064
6174612e20546865206b6579206e6565
647320746f2062652068617368656420
6265666f7265206265696e6720757365
642062792074686520484d414320616c
676f726974686d2e );
my $key = "\xaa" x 131;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = '9B09FFA71B942FCB27635FBCD5B0E944BFDC63644F0713938A7F51535C3A35E2';
is( $result, $expect, "Check $algorithm with both long key and long data" );
}
}
{
# Check HMAC-SHA384 signing function using test cases from RFC4634, section 8.4.
my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 'HMAC-SHA384' );
my $algorithm = $tsig->algorithm;
my $function = $tsig->sig_function;
{
my $data = pack 'H*', '4869205468657265';
my $key = "\x0b" x 20;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
AFD03944D84895626B0825F4AB46907F
15F9DADBE4101EC682AA034C7CEBC59C
FAEA9EA9076EDE7F4AF152E8B2FA9CB6 );
is( $result, $expect, "Check signing function for $algorithm" );
}
{
my $data = pack 'H*', '7768617420646f2079612077616e7420666f72206e6f7468696e673f';
my $key = pack 'H*', '4a656665';
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
AF45D2E376484031617F78D2B58A6B1B
9C7EF464F5A01B47E42EC3736322445E
8E2240CA5E69E2C78B3239ECFAB21649 );
is( $result, $expect, "Check $algorithm with key shorter than hash size" );
}
{
my $data = "\xdd" x 50;
my $key = "\xaa" x 20;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
88062608D3E6AD8A0AA2ACE014C8A86F
0AA635D947AC9FEBE83EF4E55966144B
2A5AB39DC13814B94E3AB6E101A34F27 );
is( $result, $expect, "Check $algorithm with data longer than hash size" );
}
{
my $data = "\xcd" x 50;
my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819';
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
3E8A69B7783C25851933AB6290AF6CA7
7A9981480850009CC5577C6E1F573B4E
6801DD23C4A7D679CCF8A386C674CFFB );
is( $result, $expect, "Check $algorithm with key and data longer than hash" );
}
{
my $data = pack 'H*', join '', qw(
54657374205573696e67204c61726765
72205468616e20426c6f636b2d53697a
65204b6579202d2048617368204b6579
204669727374 );
my $key = "\xaa" x 131;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
4ECE084485813E9088D2C63A041BC5B4
4F9EF1012A2B588F3CD11F05033AC4C6
0C2EF6AB4030FE8296248DF163F44952 );
is( $result, $expect, "Check $algorithm with key longer than block size" );
}
{
my $data = pack 'H*', join '', qw(
54686973206973206120746573742075
73696e672061206c6172676572207468
616e20626c6f636b2d73697a65206b65
7920616e642061206c61726765722074
68616e20626c6f636b2d73697a652064
6174612e20546865206b6579206e6565
647320746f2062652068617368656420
6265666f7265206265696e6720757365
642062792074686520484d414320616c
676f726974686d2e );
my $key = "\xaa" x 131;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
6617178E941F020D351E2F254E8FD32C
602420FEB0B8FB9ADCCEBB82461E99C5
A678CC31E799176D3860E6110C46523E );
is( $result, $expect, "Check $algorithm with both long key and long data" );
}
}
{
# Check HMAC-SHA512 signing function using test cases from RFC4634, section 8.4.
my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 'HMAC-SHA512' );
my $algorithm = $tsig->algorithm;
my $function = $tsig->sig_function;
{
my $data = pack 'H*', '4869205468657265';
my $key = "\x0b" x 20;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
87AA7CDEA5EF619D4FF0B4241A1D6CB0
2379F4E2CE4EC2787AD0B30545E17CDE
DAA833B7D6B8A702038B274EAEA3F4E4
BE9D914EEB61F1702E696C203A126854 );
is( $result, $expect, "Check signing function for $algorithm" );
}
{
my $data = pack 'H*', '7768617420646f2079612077616e7420666f72206e6f7468696e673f';
my $key = pack 'H*', '4a656665';
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
164B7A7BFCF819E2E395FBE73B56E0A3
87BD64222E831FD610270CD7EA250554
9758BF75C05A994A6D034F65F8F0E6FD
CAEAB1A34D4A6B4B636E070A38BCE737 );
is( $result, $expect, "Check $algorithm with key shorter than hash size" );
}
{
my $data = "\xdd" x 50;
my $key = "\xaa" x 20;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
FA73B0089D56A284EFB0F0756C890BE9
B1B5DBDD8EE81A3655F83E33B2279D39
BF3E848279A722C806B485A47E67C807
B946A337BEE8942674278859E13292FB );
is( $result, $expect, "Check $algorithm with data longer than hash size" );
}
{
my $data = "\xcd" x 50;
my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819';
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
B0BA465637458C6990E5A8C5F61D4AF7
E576D97FF94B872DE76F8050361EE3DB
A91CA5C11AA25EB4D679275CC5788063
A5F19741120C4F2DE2ADEBEB10A298DD );
is( $result, $expect, "Check $algorithm with key and data longer than hash" );
}
{
my $data = pack 'H*', join '', qw(
54657374205573696e67204c61726765
72205468616e20426c6f636b2d53697a
65204b6579202d2048617368204b6579
204669727374 );
my $key = "\xaa" x 131;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
80B24263C7C1A3EBB71493C1DD7BE8B4
9B46D1F41B4AEEC1121B013783F8F352
6B56D037E05F2598BD0FD2215D6A1E52
95E64F73F63F0AEC8B915A985D786598 );
is( $result, $expect, "Check $algorithm with key longer than block size" );
}
{
my $data = pack 'H*', join '', qw(
54686973206973206120746573742075
73696e672061206c6172676572207468
616e20626c6f636b2d73697a65206b65
7920616e642061206c61726765722074
68616e20626c6f636b2d73697a652064
6174612e20546865206b6579206e6565
647320746f2062652068617368656420
6265666f7265206265696e6720757365
642062792074686520484d414320616c
676f726974686d2e );
my $key = "\xaa" x 131;
my $result = uc unpack( 'H*', &$function( $key, $data ) );
my $expect = join '', qw(
E37B6A775DC87DBAA4DFA9F96E5E3FFD
DEBD71F8867289865DF5A32D20CDC944
B6022CAC3C4982B10D5EEB55C3E4DE15
134676FB6DE0446065C97440FA8C6A58 );
is( $result, $expect, "Check $algorithm with both long key and long data" );
}
}
exit;
Zerion Mini Shell 1.0