From 6863074f20a7c6e4a34780877206723a5d3c4e24 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?=
 <j.atria@cv-library.co.uk>
Date: Tue, 25 Jun 2024 08:19:24 +0100
Subject: [PATCH] AVRO-1523 [Perl] Fix valid range for int and long (#2974)

---
 lang/perl/Changes                   |  2 ++
 lang/perl/lib/Avro/BinaryEncoder.pm | 38 +++++++++++++++++------------
 lang/perl/t/02_bin_encode.t         | 30 ++++++++++++++---------
 3 files changed, 43 insertions(+), 27 deletions(-)

diff --git a/lang/perl/Changes b/lang/perl/Changes
index c17ed779b1e..84cbf73c58d 100644
--- a/lang/perl/Changes
+++ b/lang/perl/Changes
@@ -7,6 +7,8 @@ Revision history for Perl extension Avro
         - Support object containers without an explicit
           codec. It will be assumed to be 'null' as mandated
           by the spec.
+        - Fixed an issue that meant the minimum accepted values
+          for int and long types were off by one
 
 1.00  Fri Jan 17 15:00:00 2014
         - Relicense under apache license 2.0
diff --git a/lang/perl/lib/Avro/BinaryEncoder.pm b/lang/perl/lib/Avro/BinaryEncoder.pm
index d476f4b4a2f..18a25813e40 100644
--- a/lang/perl/lib/Avro/BinaryEncoder.pm
+++ b/lang/perl/lib/Avro/BinaryEncoder.pm
@@ -26,17 +26,22 @@ use Regexp::Common qw(number);
 
 our $VERSION = '++MODULE_VERSION++';
 
-our $max64;
-our $complement = ~0x7F;
-if ($Config{use64bitint}) {
-    $max64 = 9223372036854775807;
-}
-else {
+# Private function deleted below, should be a lexical sub
+sub _bigint {
     require Math::BigInt;
-    $complement = Math::BigInt->new("0b" . ("1" x 57) . ("0" x 7));
-    $max64      = Math::BigInt->new("0b0" . ("1" x 63));
+    my $val = Math::BigInt->new(shift);
+
+    $Config{use64bitint}
+        ? 0 + $val->bstr() # numify() loses precision
+        : $val;
 }
 
+# Avro type limits
+# Private constants deleted below
+use constant INT_MAX => 0x7FFF_FFFF;
+use constant INT_MIN => -0x8000_0000;
+use constant LONG_MAX => _bigint('0x7FFF_FFFF_FFFF_FFFF');
+use constant LONG_MIN => _bigint('-0x8000_0000_0000_0000');
 
 =head2 encode(%param)
 
@@ -95,8 +100,8 @@ sub encode_int {
     if ($data !~ /^$RE{num}{int}$/) {
         throw Avro::BinaryEncoder::Error("cannot convert '$data' to integer");
     }
-    if (abs($data) > 0x7fffffff) {
-        throw Avro::BinaryEncoder::Error("int ($data) should be <= 32bits");
+    if ($data > INT_MAX || $data < INT_MIN) {
+        throw Avro::BinaryEncoder::Error("data ($data) out of range for Avro 'int'");
     }
 
     my $enc = unsigned_varint(zigzag($data));
@@ -109,8 +114,8 @@ sub encode_long {
     if ($data !~ /^$RE{num}{int}$/) {
         throw Avro::BinaryEncoder::Error("cannot convert '$data' to long integer");
     }
-    if (abs($data) > $max64) {
-        throw Avro::BinaryEncoder::Error("int ($data) should be <= 64bits");
+    if ($data > LONG_MAX || $data < LONG_MIN) {
+        throw Avro::BinaryEncoder::Error("data ($data) out of range for Avro 'long'");
     }
     my $enc = unsigned_varint(zigzag($data));
     $cb->(\$enc);
@@ -283,14 +288,17 @@ sub zigzag {
 
 sub unsigned_varint {
     my @bytes;
-    while ($_[0] & $complement) {           # mask with continuation bit
-        push @bytes, ($_[0] & 0x7F) | 0x80; # out and set continuation bit
-        $_[0] >>= 7;                        # next please
+    while ($_[0] > 0x7F) {                  # while more than 7 bits to encode
+        push @bytes, ($_[0] & 0x7F) | 0x80; # append continuation bit and 7 data bits
+        $_[0] >>= 7;                        # get next 7 bits
     }
     push @bytes, $_[0]; # last byte
     return pack "C*", @bytes;
 }
 
+# Delete private symbols to avoid adding them to the API
+delete $Avro::BinaryEncoder::{$_} for '_bigint', <{INT,LONG}_{MIN,MAX}>;
+
 package Avro::BinaryEncoder::Error;
 use parent 'Error::Simple';
 
diff --git a/lang/perl/t/02_bin_encode.t b/lang/perl/t/02_bin_encode.t
index d64b15bf997..4a3001fe978 100644
--- a/lang/perl/t/02_bin_encode.t
+++ b/lang/perl/t/02_bin_encode.t
@@ -67,21 +67,27 @@ sub primitive_ok {
     ## BigInt values still work
     primitive_ok int     => Math::BigInt->new(-65), $p;
 
+    # test extremes
+    primitive_ok int     =>  Math::BigInt->new(2)**31 - 1, "\xfe\xff\xff\xff\x0f";
+    primitive_ok int     => -Math::BigInt->new(2)**31, "\xff\xff\xff\xff\x0f";
+    primitive_ok long    =>  Math::BigInt->new(2)**63 - 1, "\xfe\xff\xff\xff\xff\xff\xff\xff\xff\x01";
+    primitive_ok long    => -Math::BigInt->new(2)**63, "\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01";
+
+    throws_ok {
+        primitive_ok int => Math::BigInt->new(2)**31;
+    } "Avro::BinaryEncoder::Error", "32-bit signed int overflow";
+
+    throws_ok {
+        primitive_ok int => -Math::BigInt->new(2)**31 - 1;
+    } "Avro::BinaryEncoder::Error", "32-bit signed int underflow";
+
     throws_ok {
-        my $toobig;
-        if ($Config{use64bitint}) {
-            $toobig = 1<<32;
-        }
-        else {
-            require Math::BigInt;
-            $toobig = Math::BigInt->new(1)->blsft(32);
-        }
-        primitive_ok int => $toobig, undef;
-    } "Avro::BinaryEncoder::Error", "33 bits";
+        primitive_ok int => Math::BigInt->new(2)**63;
+    } "Avro::BinaryEncoder::Error", "64-bit signed int overflow";
 
     throws_ok {
-        primitive_ok int => Math::BigInt->new(1)->blsft(63), undef;
-    } "Avro::BinaryEncoder::Error", "65 bits";
+        primitive_ok long => -Math::BigInt->new(2)**63 - 1;
+    } "Avro::BinaryEncoder::Error", "64-bit signed int underflow";
 
     for (qw(long int)) {
         throws_ok {