From: Charles McGarvey Date: Tue, 3 May 2022 21:48:12 +0000 (-0600) Subject: Add support for 32-bit perls X-Git-Tag: v0.902~7 X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-File-KDBX;a=commitdiff_plain;h=16c035abaa2ff6c53076f4ff6ae3215130acb56f Add support for 32-bit perls --- diff --git a/Changes b/Changes index aec4e6a..7a64abe 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,8 @@ Revision history for File-KDBX. {{$NEXT}} + * Added support for 32-bit perls. + 0.901 2022-05-02 01:18:13-0600 * Fixed a bug where peeking at memory-protected strings and binaries does diff --git a/lib/File/KDBX.pm b/lib/File/KDBX.pm index fee9dc5..6f5c7dc 100644 --- a/lib/File/KDBX.pm +++ b/lib/File/KDBX.pm @@ -2485,13 +2485,6 @@ This software will alter its behavior depending on the value of certain environm * C - Do not use L if true (default: false) * C - Do not fork if true (default: false) -=head1 CAVEATS - -Some features (e.g. parsing) require 64-bit perl. It should be possible and actually pretty easy to make it -work using L, but I need to build a 32-bit perl in order to test it and frankly I'm still -figuring out how. I'm sure it's simple so I'll mark this one "TODO", but for now an exception will be thrown -when trying to use such features with undersized IVs. - =head1 SEE ALSO =for :list diff --git a/lib/File/KDBX/Constants.pm b/lib/File/KDBX/Constants.pm index 2bc6c8b..ba3baf3 100644 --- a/lib/File/KDBX/Constants.pm +++ b/lib/File/KDBX/Constants.pm @@ -10,6 +10,7 @@ use warnings; use strict; use Exporter qw(import); +use File::KDBX::Util qw(int64); use Scalar::Util qw(dualvar); use namespace::clean -except => 'import'; @@ -213,7 +214,7 @@ BEGIN { }, time => { __prefix => 'TIME', - SECONDS_AD1_TO_UNIX_EPOCH => 62_135_596_800, + SECONDS_AD1_TO_UNIX_EPOCH => int64('62135596800'), }, yubikey => { YUBICO_VID => dualvar( 0x1050, 'Yubico'), diff --git a/lib/File/KDBX/Dumper/V3.pm b/lib/File/KDBX/Dumper/V3.pm index cf1f1ed..22ddf57 100644 --- a/lib/File/KDBX/Dumper/V3.pm +++ b/lib/File/KDBX/Dumper/V3.pm @@ -10,7 +10,7 @@ use File::KDBX::Constants qw(:header :compression); use File::KDBX::Error; use File::KDBX::IO::Crypt; use File::KDBX::IO::HashBlock; -use File::KDBX::Util qw(:class :empty :load assert_64bit erase_scoped); +use File::KDBX::Util qw(:class :empty :int :load erase_scoped); use IO::Handle; use namespace::clean; @@ -81,8 +81,7 @@ sub _write_header { # nothing } elsif ($type == HEADER_TRANSFORM_ROUNDS) { - assert_64bit; - $val = pack('Q<', $val); + $val = pack_Ql($val); } elsif ($type == HEADER_ENCRYPTION_IV) { # nothing diff --git a/lib/File/KDBX/Dumper/V4.pm b/lib/File/KDBX/Dumper/V4.pm index d3381b6..8765e02 100644 --- a/lib/File/KDBX/Dumper/V4.pm +++ b/lib/File/KDBX/Dumper/V4.pm @@ -11,7 +11,7 @@ use File::KDBX::Constants qw(:header :inner_header :compression :kdf :variant_ma use File::KDBX::Error; use File::KDBX::IO::Crypt; use File::KDBX::IO::HmacBlock; -use File::KDBX::Util qw(:class :empty :load assert_64bit erase_scoped); +use File::KDBX::Util qw(:class :empty :int :load erase_scoped); use IO::Handle; use Scalar::Util qw(looks_like_number); use boolean qw(:all); @@ -129,9 +129,8 @@ sub _intuit_variant_type { return VMAP_TYPE_BOOL; } elsif (looks_like_number($variant) && ($variant + 0) =~ /^\d+$/) { - assert_64bit; my $neg = $variant < 0; - my @b = unpack('L>2', pack('Q>', $variant)); + my @b = unpack('L>2', scalar reverse pack_Ql($variant)); return VMAP_TYPE_INT64 if $b[0] && $neg; return VMAP_TYPE_UINT64 if $b[0]; return VMAP_TYPE_INT32 if $neg; @@ -162,8 +161,7 @@ sub _write_variant_dictionary { $val = pack('L<', $val); } elsif ($type == VMAP_TYPE_UINT64) { - assert_64bit; - $val = pack('Q<', $val); + $val = pack_Ql($val); } elsif ($type == VMAP_TYPE_BOOL) { $val = pack('C', $val); @@ -172,8 +170,7 @@ sub _write_variant_dictionary { $val = pack('l', $val); } elsif ($type == VMAP_TYPE_INT64) { - assert_64bit; - $val = pack('q<', $val); + $val = pack_ql($val); } elsif ($type == VMAP_TYPE_STRING) { $val = encode('UTF-8', $val); diff --git a/lib/File/KDBX/Dumper/XML.pm b/lib/File/KDBX/Dumper/XML.pm index 7dd23d5..345439e 100644 --- a/lib/File/KDBX/Dumper/XML.pm +++ b/lib/File/KDBX/Dumper/XML.pm @@ -9,7 +9,7 @@ use Crypt::Misc 0.029 qw(encode_b64); use Encode qw(encode); use File::KDBX::Constants qw(:version :time); use File::KDBX::Error; -use File::KDBX::Util qw(:class assert_64bit erase_scoped gzip snakify); +use File::KDBX::Util qw(:class :int erase_scoped gzip snakify); use IO::Handle; use Scalar::Util qw(blessed isdual looks_like_number); use Time::Piece; @@ -571,9 +571,8 @@ sub _encode_datetime { sub _encode_datetime_binary { local $_ = shift; - assert_64bit; my $seconds_since_ad1 = $_ + TIME_SECONDS_AD1_TO_UNIX_EPOCH; - my $buf = pack('Q<', $seconds_since_ad1->epoch); + my $buf = pack_Ql($seconds_since_ad1->epoch); return eval { encode_b64($buf) }; } diff --git a/lib/File/KDBX/IO/HmacBlock.pm b/lib/File/KDBX/IO/HmacBlock.pm index 50f054b..e61ad15 100644 --- a/lib/File/KDBX/IO/HmacBlock.pm +++ b/lib/File/KDBX/IO/HmacBlock.pm @@ -8,7 +8,7 @@ use Crypt::Digest qw(digest_data); use Crypt::Mac::HMAC qw(hmac); use Errno; use File::KDBX::Error; -use File::KDBX::Util qw(:class :io assert_64bit); +use File::KDBX::Util qw(:class :int :io); use namespace::clean; extends 'File::KDBX::IO'; @@ -28,7 +28,7 @@ HMAC-SHA256 key for authenticating the data stream (required) =cut my %ATTRS = ( - _block_index => 0, + _block_index => int64(0), _buffer => sub { \(my $buf = '') }, _finished => 0, block_size => sub { $BLOCK_SIZE }, @@ -53,8 +53,6 @@ Construct a new HMAC-block stream IO handle. =cut sub new { - assert_64bit; - my $class = shift; my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_; my $self = $class->SUPER::new; @@ -158,7 +156,7 @@ sub _read_hashed_block { or throw 'Failed to read HMAC block', index => $self->_block_index, size => $size; } - my $packed_index = pack('Q<', $self->_block_index); + my $packed_index = pack_Ql($self->_block_index); my $got_hmac = hmac('SHA256', $self->_hmac_key, $packed_index, $packed_size, @@ -185,7 +183,7 @@ sub _write_next_hmac_block { my $block = ''; $block = substr($$buffer, 0, $size, '') if 0 < $size; - my $packed_index = pack('Q<', $self->_block_index); + my $packed_index = pack_Ql($self->_block_index); my $packed_size = pack('L<', $size); my $hmac = hmac('SHA256', $self->_hmac_key, $packed_index, @@ -212,7 +210,7 @@ sub _hmac_key { my $key = shift // $self->key; my $index = shift // $self->_block_index; - my $packed_index = pack('Q<', $index); + my $packed_index = pack_Ql($index); my $hmac_key = digest_data('SHA512', $packed_index, $key); return $hmac_key; } diff --git a/lib/File/KDBX/Loader/V3.pm b/lib/File/KDBX/Loader/V3.pm index e65a5e7..cf69ae6 100644 --- a/lib/File/KDBX/Loader/V3.pm +++ b/lib/File/KDBX/Loader/V3.pm @@ -22,7 +22,7 @@ use File::KDBX::Constants qw(:header :compression :kdf); use File::KDBX::Error; use File::KDBX::IO::Crypt; use File::KDBX::IO::HashBlock; -use File::KDBX::Util qw(:class :io :load assert_64bit erase_scoped); +use File::KDBX::Util qw(:class :int :io :load erase_scoped); use namespace::clean; extends 'File::KDBX::Loader'; @@ -62,8 +62,7 @@ sub _read_header { # nothing } elsif ($type == HEADER_TRANSFORM_ROUNDS) { - assert_64bit; - $val = unpack('Q<', $val); + ($val) = unpack_Ql($val); } elsif ($type == HEADER_ENCRYPTION_IV) { # nothing @@ -75,7 +74,7 @@ sub _read_header { # nothing } elsif ($type == HEADER_INNER_RANDOM_STREAM_ID) { - $val = unpack('L<', $val); + ($val) = unpack('L<', $val); } elsif ($type == HEADER_KDF_PARAMETERS || $type == HEADER_PUBLIC_CUSTOM_DATA) { diff --git a/lib/File/KDBX/Loader/V4.pm b/lib/File/KDBX/Loader/V4.pm index 3480209..602b058 100644 --- a/lib/File/KDBX/Loader/V4.pm +++ b/lib/File/KDBX/Loader/V4.pm @@ -22,7 +22,7 @@ use Crypt::Mac::HMAC qw(hmac); use Encode qw(decode); use File::KDBX::Constants qw(:header :inner_header :variant_map :compression); use File::KDBX::Error; -use File::KDBX::Util qw(:class :io :load assert_64bit erase_scoped); +use File::KDBX::Util qw(:class :int :io :load erase_scoped); use File::KDBX::IO::Crypt; use File::KDBX::IO::HmacBlock; use boolean; @@ -116,8 +116,7 @@ sub _read_variant_dictionary { ($val) = unpack('L<', $val); } elsif ($type == VMAP_TYPE_UINT64) { - assert_64bit; - ($val) = unpack('Q<', $val); + ($val) = unpack_Ql($val); } elsif ($type == VMAP_TYPE_BOOL) { ($val) = unpack('C', $val); @@ -127,8 +126,7 @@ sub _read_variant_dictionary { ($val) = unpack('l<', $val); } elsif ($type == VMAP_TYPE_INT64) { - assert_64bit; - ($val) = unpack('q<', $val); + ($val) = unpack_ql($val); } elsif ($type == VMAP_TYPE_STRING) { $val = decode('UTF-8', $val); diff --git a/lib/File/KDBX/Loader/XML.pm b/lib/File/KDBX/Loader/XML.pm index 00676a1..1931153 100644 --- a/lib/File/KDBX/Loader/XML.pm +++ b/lib/File/KDBX/Loader/XML.pm @@ -9,7 +9,7 @@ use Encode qw(decode); use File::KDBX::Constants qw(:version :time); use File::KDBX::Error; use File::KDBX::Safe; -use File::KDBX::Util qw(:class :text assert_64bit gunzip erase_scoped); +use File::KDBX::Util qw(:class :int :text gunzip erase_scoped); use Scalar::Util qw(looks_like_number); use Time::Piece; use XML::LibXML::Reader; @@ -533,9 +533,8 @@ sub _decode_datetime { throw 'Failed to parse binary datetime', text => $_, error => $err; } throw $@ if $@; - assert_64bit; $binary .= \0 x (8 - length($binary)) if length($binary) < 8; - my ($seconds_since_ad1) = unpack('Q<', $binary); + my ($seconds_since_ad1) = unpack_Ql($binary); my $epoch = $seconds_since_ad1 - TIME_SECONDS_AD1_TO_UNIX_EPOCH; return Time::Piece->new($epoch); } diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm index a27f4dd..62515f5 100644 --- a/lib/File/KDBX/Util.pm +++ b/lib/File/KDBX/Util.pm @@ -7,7 +7,6 @@ use strict; use Crypt::PRNG qw(random_bytes random_string); use Encode qw(decode encode); use Exporter qw(import); -use File::KDBX::Constants qw(:bool); use File::KDBX::Error; use List::Util 1.33 qw(any all); use Module::Load; @@ -20,7 +19,7 @@ use namespace::clean -except => 'import'; our $VERSION = '999.999'; # VERSION our %EXPORT_TAGS = ( - assert => [qw(DEBUG assert assert_64bit)], + assert => [qw(DEBUG assert)], class => [qw(extends has list_attributes)], clone => [qw(clone clone_nomagic)], coercion => [qw(to_bool to_number to_string to_time to_tristate to_uuid)], @@ -31,7 +30,8 @@ our %EXPORT_TAGS = ( empty => [qw(empty nonempty)], erase => [qw(erase erase_scoped)], gzip => [qw(gzip gunzip)], - io => [qw(is_readable is_writable read_all)], + int => [qw(int64 pack_ql pack_Ql unpack_ql unpack_Ql)], + io => [qw(read_all)], load => [qw(load_optional load_xs try_load_optional)], search => [qw(query query_any search simple_expression_query)], text => [qw(snakify trim)], @@ -101,8 +101,8 @@ my %ATTRIBUTES; $bool = load_xs(); $bool = load_xs($version); -Attempt to load L. Return truthy if C is loaded. If C<$version> is given, it will check -that at least the given version is loaded. +Attempt to load L. Return truthy if it is loaded. If C<$version> is given, it will check that +at least the given version is loaded. =cut @@ -113,7 +113,7 @@ sub load_xs { goto IS_LOADED if defined $XS_LOADED; if ($ENV{PERL_ONLY} || (exists $ENV{PERL_FILE_KDBX_XS} && !$ENV{PERL_FILE_KDBX_XS})) { - return $XS_LOADED = FALSE; + return $XS_LOADED = !1; } $XS_LOADED = !!eval { require File::KDBX::XS; 1 }; @@ -152,20 +152,6 @@ sub assert(&) { ## no critic (ProhibitSubroutinePrototypes) die "$0: $file:$line: Assertion failed$assertion\n"; } -=func assert_64bit - - assert_64bit(); - -Throw if perl doesn't support 64-bit IVs. - -=cut - -sub assert_64bit() { - require Config; - $Config::Config{ivsize} < 8 - and throw "64-bit perl is required to use this feature.\n", ivsize => $Config::Config{ivsize}; -} - =func can_fork $bool = can_fork; @@ -582,19 +568,115 @@ sub gzip { return $out; } -=func is_readable +=func int64 + + $int = int64($string); + +Get a scalar integer capable of holding 64-bit values, initialized with a given default value. On a 64-bit +perl, it will return a regular SvIV. On a 32-bit perl it will return a L. + +=cut + +sub int64 { + require Config; + if ($Config::Config{ivsize} < 8) { + require Math::BigInt; + return Math::BigInt->new(@_); + } + return 0 + shift; +} + +=func pack_Ql + + $bytes = pack_Ql($int); + +Like C', $int)>, but also works on 32-bit perls. + +=cut + +sub pack_Ql { + my $num = shift; + require Config; + if ($Config::Config{ivsize} < 8) { + if (blessed $num && $num->can('to_hex')) { + return "\xff\xff\xff\xff\xff\xff\xff\xff" if Math::BigInt->new('18446744073709551615') <= $num; + return "\x00\x00\x00\x00\x00\x00\x00\x80" if $num <= Math::BigInt->new('-9223372036854775808'); + my $neg; + if ($num < 0) { + $neg = 1; + $num = -$num; + } + my $bytes = reverse pack('H16', substr(('0' x 15) . $num->to_hex, -16)); + $bytes .= "\0" x (8 - length $bytes) if length $bytes < 8; + if ($neg) { + # two's compliment + $bytes = join('', map { chr(~ord($_) & 0xff) } split(//, $bytes)); + substr($bytes, 0, 1, chr(ord(substr($bytes, 0, 1)) + 1)); + } + return $bytes; + } + else { + my $pad = $num < 0 ? "\xff" : "\0"; + return pack('L<', $num) . ($pad x 4); + }; + } + return pack('Q<', $num); +} + +=func pack_ql + + $bytes = pack_ql($int); -=func is_writable +Like C', $int)>, but also works on 32-bit perls. - $bool = is_readable($mode); - $bool = is_writable($mode); +=cut -Determine of an C-style mode is readable, writable or both. +sub pack_ql { goto &pack_Ql } + +=func unpack_Ql + + $int = unpack_Ql($bytes); + +Like C', $bytes)>, but also works on 32-bit perls. =cut -sub is_readable { $_[0] !~ /^[aw]b?$/ } -sub is_writable { $_[0] !~ /^rb?$/ } +sub unpack_Ql { + my $bytes = shift; + require Config; + if ($Config::Config{ivsize} < 8) { + require Math::BigInt; + return (Math::BigInt->new('0x' . unpack('H*', scalar reverse $bytes))); + } + return unpack('Q<', $bytes); +} + +=func unpack_ql + + $int = unpack_ql($bytes); + +Like C', $bytes)>, but also works on 32-bit perls. + +=cut + +sub unpack_ql { + my $bytes = shift; + require Config; + if ($Config::Config{ivsize} < 8) { + require Math::BigInt; + if (ord(substr($bytes, -1, 1)) & 128) { + return (Math::BigInt->new('-9223372036854775808')) if $bytes eq "\x00\x00\x00\x00\x00\x00\x00\x80"; + # two's compliment + substr($bytes, 0, 1, chr(ord(substr($bytes, 0, 1)) - 1)); + $bytes = join('', map { chr(~ord($_) & 0xff) } split(//, $bytes)); + return (-Math::BigInt->new('0x' . unpack('H*', scalar reverse $bytes))); + } + else { + return (Math::BigInt->new('0x' . unpack('H*', scalar reverse $bytes))); + } + } + return unpack('q<', $bytes); +} =func is_uuid diff --git a/t/kdbx2.t b/t/kdbx2.t index 958348a..af67061 100644 --- a/t/kdbx2.t +++ b/t/kdbx2.t @@ -38,7 +38,7 @@ sub verify_kdbx2 { inner_random_stream_key => "\214\aW\253\362\177<\346n`\263l\245\353T\25\261BnFp\177\357\335\36(b\372z\231b\355", kdf_parameters => { "\$UUID" => "\311\331\363\232b\212D`\277t\r\b\301\212O\352", - R => 6000, + R => num(6000), S => "S\202\207A\3475\265\177\220\331\263[\334\326\365\324B\\\2222zb-f\263m\220\333S\361L\332", }, master_seed => "\253!\2\241\r*|{\227\0276Lx\215\32\\\17\372d\254\255*\21r\376\251\313+gMI\343", diff --git a/t/kdbx3.t b/t/kdbx3.t index fac6101..e1e5838 100644 --- a/t/kdbx3.t +++ b/t/kdbx3.t @@ -25,7 +25,7 @@ subtest 'Verify Format300' => sub { inner_random_stream_key => "\346\n8\2\322\264i\5\5\274\22\377+\16tB\353\210\1\2m\2U%\326\347\355\313\313\340A\305", kdf_parameters => { "\$UUID" => "\311\331\363\232b\212D`\277t\r\b\301\212O\352", - R => 6000, + R => num(6000), S => "\340\377\235\255\222o\1(\226m\373\tC{K\352\f\332M\302|~P\e\346J\@\275A\227\236\366", }, master_seed => "Z\230\355\353\2303\361\237-p\345\27nM\22 sub { inner_random_stream_key => "Z\244]\373\13`\2108=>\r\224\351\373\316\276\253\6\317z\356\302\36\fW\1776Q\366\32\34,", kdf_parameters => { "\$UUID" => "\311\331\363\232b\212D`\277t\r\b\301\212O\352", - R => 6000, + R => num(6000), S => "l\254\250\255\240U\313\364\336\316#\254\306\231\f%U\207J\235\275\34\b\25036\26\241\a\300\26\332", }, master_seed => "\13\350\370\214{\0276\17dv\31W[H\26\272\4\335\377\356\275N\"\2A1\364\213\226\237\303M", @@ -72,7 +72,7 @@ subtest 'Verify Compressed' => sub { inner_random_stream_key => "+\232\222\302\20\333\254\342YD\371\34\373,\302:\303\247\t\26\$\a\370g\314\32J\240\371;U\234", kdf_parameters => { "\$UUID" => "\311\331\363\232b\212D`\277t\r\b\301\212O\352", - R => 6000, + R => num(6000), S => "\3!\230hx\363\220nV\23\340\316\262\210\26Z\al?\343\240\260\325\262\31i\223y\b\306\344V", }, master_seed => "\0206\244\265\203m14\257T\372o\16\271\306\347\215\365\376\304\20\356\344\3713\3\303\363\a\5\205\325", @@ -96,7 +96,7 @@ subtest 'Verify ProtectedStrings' => sub { kdf_parameters => ignore(), kdf_parameters => { "\$UUID" => "\311\331\363\232b\212D`\277t\r\b\301\212O\352", - R => 6000, + R => num(6000), S => "y\251\327\312mW8B\351\273\364#T#m:\370k1\240v\360E\245\304\325\265\313\337\245\211E", }, master_seed => "\355\32<1\311\320\315\24\204\325\250\35+\2525\321\224x?\361\355\310V\322\20\331\324\"\372\334\210\233", diff --git a/t/kdbx4.t b/t/kdbx4.t index f1e9cbc..5afceeb 100644 --- a/t/kdbx4.t +++ b/t/kdbx4.t @@ -25,11 +25,11 @@ subtest 'Verify Format400' => sub { encryption_iv => "3?\207P\233or\220\215h\2240", kdf_parameters => { "\$UUID" => "\357cm\337\214)DK\221\367\251\244\3\343\n\f", - I => 2, - M => 1048576, - P => 2, + I => num(2), + M => num(1048576), + P => num(2), S => "V\254\6m-\206*\260\305\f\0\366\24:4\235\364A\362\346\221\13)}\250\217P\303\303\2\331\245", - V => 19, + V => num(19), }, master_seed => ";\372y\300yS%\3331\177\231\364u\265Y\361\225\3273h\332R,\22\240a\240\302\271\357\313\23", }, 'Extract headers' or diag explain $kdbx->headers; diff --git a/t/lib/TestCommon.pm b/t/lib/TestCommon.pm index e499251..33438d3 100644 --- a/t/lib/TestCommon.pm +++ b/t/lib/TestCommon.pm @@ -98,4 +98,5 @@ sub fast_kdf { } return $params; } + 1; diff --git a/t/util.t b/t/util.t index 5ea4359..5c26c9d 100644 --- a/t/util.t +++ b/t/util.t @@ -7,10 +7,11 @@ use lib 't/lib'; use TestCommon; use File::KDBX::Util qw(:all); +use Math::BigInt 1.999808; +use Scalar::Util qw(blessed); use Test::More; can_ok('File::KDBX::Util', qw{ - assert_64bit can_fork dumper empty @@ -132,4 +133,58 @@ subtest 'Padding' => sub { like exception { pad_pkcs7('bar', 0) }, qr/must provide block size/i, 'Size must be non-zero'; }; +subtest '64-bit packing' => sub { + for my $test ( + # bytes, value + ["\xfe\xff\xff\xff\xff\xff\xff\xff", -2], + ["\xff\xff\xff\xff\xff\xff\xff\xff", -1], + ["\x00\x00\x00\x00\x00\x00\x00\x00", 0], + ["\x01\x00\x00\x00\x00\x00\x00\x00", 1], + ["\x02\x00\x00\x00\x00\x00\x00\x00", 2], + ["\x01\x01\x00\x00\x00\x00\x00\x00", 257], + ["\xfe\xff\xff\xff\xff\xff\xff\xff", Math::BigInt->new('-2')], + ["\xff\xff\xff\xff\xff\xff\xff\xff", Math::BigInt->new('-1')], + ["\x00\x00\x00\x00\x00\x00\x00\x00", Math::BigInt->new('0')], + ["\x01\x00\x00\x00\x00\x00\x00\x00", Math::BigInt->new('1')], + ["\x02\x00\x00\x00\x00\x00\x00\x00", Math::BigInt->new('2')], + ["\x01\x01\x00\x00\x00\x00\x00\x00", Math::BigInt->new('257')], + ["\xfe\xff\xff\xff\xff\xff\xff\xff", Math::BigInt->new('18446744073709551614')], + ["\xff\xff\xff\xff\xff\xff\xff\xff", Math::BigInt->new('18446744073709551615')], + ["\xff\xff\xff\xff\xff\xff\xff\xff", Math::BigInt->new('18446744073709551616')], # overflow + ["\x02\x00\x00\x00\x00\x00\x00\x80", Math::BigInt->new('-9223372036854775806')], + ["\x01\x00\x00\x00\x00\x00\x00\x80", Math::BigInt->new('-9223372036854775807')], + ["\x00\x00\x00\x00\x00\x00\x00\x80", Math::BigInt->new('-9223372036854775808')], + ["\x00\x00\x00\x00\x00\x00\x00\x80", Math::BigInt->new('-9223372036854775809')], # overflow + ) { + my ($bytes, $num) = @$test; + my $desc = sprintf('Pack %s => %s', $num, unpack('H*', $bytes)); + $desc =~ s/^(Pack)/$1 bigint/ if blessed $num; + my $p = pack_Ql($num); + is $p, $bytes, $desc or diag unpack('H*', $p); + } + + for my $test ( + # bytes, unsigned value, signed value + ["\x00\x00\x00\x00\x00\x00\x00\x00", 0, 0], + ["\x01\x00\x00\x00\x00\x00\x00\x00", 1, 1], + ["\x02\x00\x00\x00\x00\x00\x00\x00", 2, 2], + ["\xfe\xff\xff\xff\xff\xff\xff\xff", Math::BigInt->new('18446744073709551614'), -2], + ["\xff\xff\xff\xff\xff\xff\xff\xff", Math::BigInt->new('18446744073709551615'), -1], + ["\x02\x00\x00\x00\x00\x00\x00\x80", Math::BigInt->new('9223372036854775810'), + Math::BigInt->new('-9223372036854775806')], + ["\x01\x00\x00\x00\x00\x00\x00\x80", Math::BigInt->new('9223372036854775809'), + Math::BigInt->new('-9223372036854775807')], + ["\x00\x00\x00\x00\x00\x00\x00\x80", Math::BigInt->new('9223372036854775808'), + Math::BigInt->new('-9223372036854775808')], + ) { + my ($bytes, $num1, $num2) = @$test; + my $desc = sprintf('Unpack %s => %s', unpack('H*', $bytes), $num1); + my $p = unpack_Ql($bytes); + cmp_ok $p, '==', $num1, $desc or diag $p; + $desc = sprintf('Unpack signed %s => %s', unpack('H*', $bytes), $num2); + my $q = unpack_ql($bytes); + cmp_ok $q, '==', $num2, $desc or diag $q; + }; +}; + done_testing;