Commit b3e8681e59 for perl
commit b3e8681e59ca0bd877f67cfcbf0eb0749a2bccd9
Author: Eric Herman <eric@freesa.org>
Date: Wed Oct 28 16:26:35 2026 +0000
cpan/libnet - Update to version 3.16
3.16 2026-10-24
- Fix unbounded response buffering vulnerabilities in Net::Cmd. [Jitka
Plesnikova, CVE-2026-93469]
Co-authored-by: Philippe Bruhat (BooK) <philippe@bruhat.net>
diff --git a/MANIFEST b/MANIFEST
index b50b12db74..94a6576384 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1582,6 +1582,7 @@ cpan/libnet/lib/Net/POP3.pm Module related to libnet
cpan/libnet/lib/Net/SMTP.pm Module related to libnet
cpan/libnet/lib/Net/Time.pm Module related to libnet
cpan/libnet/Makefile.PL libnet
+cpan/libnet/t/cmd_buffer_limits.t libnet
cpan/libnet/t/config.t libnet
cpan/libnet/t/datasend.t libnet
cpan/libnet/t/ftp.t libnet
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 3e358257b1..d96deceb2a 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -745,8 +745,8 @@ our %Modules = (
},
'libnet' => {
- 'DISTRIBUTION' => 'SHAY/libnet-3.15.tar.gz',
- 'SYNCINFO' => 'yorton on Mon Mar 20 20:48:38 2023',
+ 'DISTRIBUTION' => 'SHAY/libnet-3.16.tar.gz',
+ 'SYNCINFO' => 'eric on Wed Oct 28 16:25:04 2026',
'MAIN_MODULE' => 'Net::Cmd',
'FILES' => q[cpan/libnet],
'EXCLUDED' => [
diff --git a/cpan/libnet/Makefile.PL b/cpan/libnet/Makefile.PL
index 141b27635e..f4cbf9a9bb 100644
--- a/cpan/libnet/Makefile.PL
+++ b/cpan/libnet/Makefile.PL
@@ -66,7 +66,7 @@ MAIN: {
ABSTRACT => 'Collection of network protocol modules',
AUTHOR => 'Graham Barr <gbarr@pobox.com>, Steve Hay <shay@cpan.org>',
LICENSE => 'perl_5',
- VERSION => '3.15',
+ VERSION => '3.16',
META_MERGE => {
'meta-spec' => {
diff --git a/cpan/libnet/lib/Net/Cmd.pm b/cpan/libnet/lib/Net/Cmd.pm
index f10df74354..7f8fdbe094 100644
--- a/cpan/libnet/lib/Net/Cmd.pm
+++ b/cpan/libnet/lib/Net/Cmd.pm
@@ -1,7 +1,7 @@
# Net::Cmd.pm
#
# Copyright (C) 1995-2006 Graham Barr. All rights reserved.
-# Copyright (C) 2013-2016, 2020, 2022 Steve Hay. All rights reserved.
+# Copyright (C) 2013-2016, 2020, 2022, 2026 Steve Hay. All rights reserved.
# This module is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself, i.e. under the terms of either the GNU General
# Public License or the Artistic License, as specified in the F<LICENCE> file.
@@ -26,7 +26,7 @@ BEGIN {
}
}
-our $VERSION = "3.15";
+our $VERSION = "3.16";
our @ISA = qw(Exporter);
our @EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
@@ -258,6 +258,42 @@ sub _set_status_closed {
. "(): unexpected EOF on command channel: $err") if $cmd->debug;
}
+# Max length of an incomplete response line
+sub max_partial_bytes { 1024 * 1024 } # 1 MiB
+
+# Max total size of a multiline response
+sub max_resp_bytes { 8 * 1024 * 1024 } # 8 MiB
+
+# Max total size of a dot-terminated body
+sub max_dotread_bytes { 32 * 1024 * 1024 } # 32 MiB
+
+sub _set_status_line_too_long {
+ my $cmd = shift;
+ my $pkg = ref($cmd) || $cmd;
+
+ $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Response line too long");
+ carp(ref($cmd) . ": " . (caller(1))[3]
+ . "(): response line too long") if $cmd->debug;
+}
+
+sub _set_status_resp_too_large {
+ my $cmd = shift;
+ my $pkg = ref($cmd) || $cmd;
+
+ $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Response too large");
+ carp(ref($cmd) . ": " . (caller(1))[3]
+ . "(): response too large") if $cmd->debug;
+}
+
+sub _set_status_dotread_too_large {
+ my $cmd = shift;
+ my $pkg = ref($cmd) || $cmd;
+
+ $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Dot-read too large");
+ carp(ref($cmd) . ": " . (caller(1))[3]
+ . "(): dot-read too large") if $cmd->debug;
+}
+
sub _is_closed {
my $cmd = shift;
if (!defined fileno($cmd)) {
@@ -350,6 +386,12 @@ sub getline {
return;
}
+ if (length($partial) + length($buf) > $cmd->max_partial_bytes) {
+ $cmd->close;
+ $cmd->_set_status_line_too_long;
+ return;
+ }
+
substr($buf, 0, 0) = $partial; ## prepend from last sysread
my @buf = split(/\015?\012/, $buf, -1); ## break into lines
@@ -398,6 +440,8 @@ sub response {
$cmd->set_status($cmd->DEF_REPLY_CODE, undef); # initialize the response
+ my $resp_bytes = 0;
+
while (1) {
my $str = $cmd->getline();
@@ -418,6 +462,12 @@ sub response {
${*$cmd}{'net_cmd_code'} = $code;
push(@{${*$cmd}{'net_cmd_resp'}}, $str);
+ $resp_bytes += length($str);
+ if ($resp_bytes > $cmd->max_resp_bytes) {
+ $cmd->close;
+ $cmd->_set_status_resp_too_large;
+ return CMD_ERROR;
+ }
last unless ($more);
}
@@ -431,6 +481,7 @@ sub read_until_dot {
my $cmd = shift;
my $fh = shift;
my $arr = [];
+ my $total = 0;
while (1) {
my $str = $cmd->getline() or return;
@@ -447,6 +498,12 @@ sub read_until_dot {
}
else {
push(@$arr, $str);
+ $total += length($str);
+ if ($total > $cmd->max_dotread_bytes) {
+ $cmd->close;
+ $cmd->_set_status_dotread_too_large;
+ return;
+ }
}
}
@@ -805,6 +862,27 @@ the server after issuing a command that expects data to be written.
See the Net::POP3 and Net::SMTP modules for examples of this.
+=item C<max_partial_bytes()>
+
+Returns the maximum number of bytes that an incomplete response line (data
+received without a terminating CRLF) may accumulate before the connection
+is closed with an error. The default is 1 MiB. Override this method in a
+subclass to change the limit.
+
+=item C<max_resp_bytes()>
+
+Returns the maximum number of bytes that a multiline response (NNN-...
+continuation lines accumulated by C<response()>) may occupy before the
+connection is closed with an error. The default is 8 MiB. Override this
+method in a subclass to change the limit.
+
+=item C<max_dotread_bytes()>
+
+Returns the maximum number of bytes that a dot-terminated body read (data
+accumulated by C<read_until_dot()> when no filehandle is supplied) may
+occupy before the connection is closed with an error. The default is
+32 MiB. Override this method in a subclass to change the limit.
+
=back
=head2 Pseudo Responses
@@ -843,6 +921,33 @@ that subclassed C<Net::Cmd>). The _set_status_timeout() method
can be overridden to set a different message (by calling set_status())
or otherwise trap this error.
+=item Response line too long
+
+If an incomplete response line (data received without a terminating CRLF)
+exceeds the C<max_partial_bytes()> limit, C<code()> will return "421" and
+C<message()> will return "[$pkg] Response line too long" (where $pkg is
+the name of the class that subclassed C<Net::Cmd>). The
+C<_set_status_line_too_long()> method can be overridden to set a different
+message or otherwise trap this error.
+
+=item Response too large
+
+If the accumulated bytes of a multiline response (NNN-... continuation
+lines) exceed the C<max_resp_bytes()> limit, C<code()> will return "421"
+and C<message()> will return "[$pkg] Response too large" (where $pkg is
+the name of the class that subclassed C<Net::Cmd>). The
+C<_set_status_resp_too_large()> method can be overridden to set a different
+message or otherwise trap this error.
+
+=item Dot-read body too large
+
+If the accumulated bytes of a dot-terminated body read (when no filehandle
+is supplied) exceed the C<max_dotread_bytes()> limit, C<code()> will return
+"421" and C<message()> will return "[$pkg] Dot-read too large" (where $pkg
+is the name of the class that subclassed C<Net::Cmd>). The
+C<_set_status_dotread_too_large()> method can be overridden to set a
+different message or otherwise trap this error.
+
=back
=head1 EXPORTS
@@ -887,7 +992,7 @@ libnet as of version 1.22_02.
Copyright (C) 1995-2006 Graham Barr. All rights reserved.
-Copyright (C) 2013-2016, 2020, 2022 Steve Hay. All rights reserved.
+Copyright (C) 2013-2016, 2020, 2022, 2026 Steve Hay. All rights reserved.
=head1 LICENCE
@@ -897,11 +1002,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/Config.pm b/cpan/libnet/lib/Net/Config.pm
index bdbd0034d8..4cb61d62fc 100644
--- a/cpan/libnet/lib/Net/Config.pm
+++ b/cpan/libnet/lib/Net/Config.pm
@@ -18,7 +18,7 @@ use Socket qw(inet_aton inet_ntoa);
our @EXPORT = qw(%NetConfig);
our @ISA = qw(Net::LocalCfg Exporter);
-our $VERSION = "3.15";
+our $VERSION = "3.16";
our($CONFIGURE, $LIBNET_CFG);
@@ -368,11 +368,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/Domain.pm b/cpan/libnet/lib/Net/Domain.pm
index bf1ad2547b..fc28b5b9ca 100644
--- a/cpan/libnet/lib/Net/Domain.pm
+++ b/cpan/libnet/lib/Net/Domain.pm
@@ -19,7 +19,7 @@ use Net::Config;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
-our $VERSION = "3.15";
+our $VERSION = "3.16";
my ($host, $domain, $fqdn) = (undef, undef, undef);
@@ -395,11 +395,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/FTP.pm b/cpan/libnet/lib/Net/FTP.pm
index cee0b2846b..b5ff197f38 100644
--- a/cpan/libnet/lib/Net/FTP.pm
+++ b/cpan/libnet/lib/Net/FTP.pm
@@ -23,7 +23,7 @@ use Net::Config;
use Socket;
use Time::Local;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
our $IOCLASS;
my $family_key;
@@ -2024,11 +2024,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/FTP/A.pm b/cpan/libnet/lib/Net/FTP/A.pm
index 9b93e16cbc..b10af0d05a 100644
--- a/cpan/libnet/lib/Net/FTP/A.pm
+++ b/cpan/libnet/lib/Net/FTP/A.pm
@@ -13,7 +13,7 @@ use Carp;
use Net::FTP::dataconn;
our @ISA = qw(Net::FTP::dataconn);
-our $VERSION = "3.15";
+our $VERSION = "3.16";
our $buf;
diff --git a/cpan/libnet/lib/Net/FTP/E.pm b/cpan/libnet/lib/Net/FTP/E.pm
index a10b9729f0..44c0848b4d 100644
--- a/cpan/libnet/lib/Net/FTP/E.pm
+++ b/cpan/libnet/lib/Net/FTP/E.pm
@@ -8,6 +8,6 @@ use warnings;
use Net::FTP::I;
our @ISA = qw(Net::FTP::I);
-our $VERSION = "3.15";
+our $VERSION = "3.16";
1;
diff --git a/cpan/libnet/lib/Net/FTP/I.pm b/cpan/libnet/lib/Net/FTP/I.pm
index 1c2b8a6088..e06cef09cf 100644
--- a/cpan/libnet/lib/Net/FTP/I.pm
+++ b/cpan/libnet/lib/Net/FTP/I.pm
@@ -13,7 +13,7 @@ use Carp;
use Net::FTP::dataconn;
our @ISA = qw(Net::FTP::dataconn);
-our $VERSION = "3.15";
+our $VERSION = "3.16";
our $buf;
diff --git a/cpan/libnet/lib/Net/FTP/L.pm b/cpan/libnet/lib/Net/FTP/L.pm
index d04fd920aa..d030abd8c3 100644
--- a/cpan/libnet/lib/Net/FTP/L.pm
+++ b/cpan/libnet/lib/Net/FTP/L.pm
@@ -8,6 +8,6 @@ use warnings;
use Net::FTP::I;
our @ISA = qw(Net::FTP::I);
-our $VERSION = "3.15";
+our $VERSION = "3.16";
1;
diff --git a/cpan/libnet/lib/Net/FTP/dataconn.pm b/cpan/libnet/lib/Net/FTP/dataconn.pm
index 3db008df95..2510670623 100644
--- a/cpan/libnet/lib/Net/FTP/dataconn.pm
+++ b/cpan/libnet/lib/Net/FTP/dataconn.pm
@@ -13,7 +13,7 @@ use Carp;
use Errno;
use Net::Cmd;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
$Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn";
our @ISA = $Net::FTP::IOCLASS;
@@ -224,11 +224,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/NNTP.pm b/cpan/libnet/lib/Net/NNTP.pm
index 59ed0ef5b3..36618f9c2b 100644
--- a/cpan/libnet/lib/Net/NNTP.pm
+++ b/cpan/libnet/lib/Net/NNTP.pm
@@ -19,7 +19,7 @@ use Net::Cmd;
use Net::Config;
use Time::Local;
-our $VERSION = "3.15";
+our $VERSION = "3.16";
# Code for detecting if we can use SSL
my $ssl_class = eval {
@@ -1308,11 +1308,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/Netrc.pm b/cpan/libnet/lib/Net/Netrc.pm
index fe9abb9ddd..f1e95d85c7 100644
--- a/cpan/libnet/lib/Net/Netrc.pm
+++ b/cpan/libnet/lib/Net/Netrc.pm
@@ -16,7 +16,7 @@ use warnings;
use Carp;
use FileHandle;
-our $VERSION = "3.15";
+our $VERSION = "3.16";
our $TESTING;
@@ -353,11 +353,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/POP3.pm b/cpan/libnet/lib/Net/POP3.pm
index e6239c7c86..2994833f84 100644
--- a/cpan/libnet/lib/Net/POP3.pm
+++ b/cpan/libnet/lib/Net/POP3.pm
@@ -18,7 +18,7 @@ use IO::Socket;
use Net::Cmd;
use Net::Config;
-our $VERSION = "3.15";
+our $VERSION = "3.16";
# Code for detecting if we can use SSL
my $ssl_class = eval {
@@ -869,11 +869,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/SMTP.pm b/cpan/libnet/lib/Net/SMTP.pm
index e592bb53e4..0701793bb8 100644
--- a/cpan/libnet/lib/Net/SMTP.pm
+++ b/cpan/libnet/lib/Net/SMTP.pm
@@ -19,7 +19,7 @@ use Net::Cmd;
use Net::Config;
use Socket;
-our $VERSION = "3.15";
+our $VERSION = "3.16";
# Code for detecting if we can use SSL
my $ssl_class = eval {
@@ -1052,11 +1052,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/lib/Net/Time.pm b/cpan/libnet/lib/Net/Time.pm
index 237c1747a4..f75a2987d0 100644
--- a/cpan/libnet/lib/Net/Time.pm
+++ b/cpan/libnet/lib/Net/Time.pm
@@ -22,7 +22,7 @@ use Net::Config;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(inet_time inet_daytime);
-our $VERSION = "3.15";
+our $VERSION = "3.16";
our $TIMEOUT = 120;
@@ -190,11 +190,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 3.15
+Version 3.16
=head1 DATE
-20 March 2023
+24 Oct 2026
=head1 HISTORY
diff --git a/cpan/libnet/t/cmd_buffer_limits.t b/cpan/libnet/t/cmd_buffer_limits.t
new file mode 100644
index 0000000000..efa46df4bf
--- /dev/null
+++ b/cpan/libnet/t/cmd_buffer_limits.t
@@ -0,0 +1,404 @@
+#!perl
+#===============================================================================
+#
+# t/cmd_buffer_limits.t
+#
+# DESCRIPTION
+# Tests for the three unbounded-response-buffering vulnerabilities fixed in:
+#
+# 3b6f054 Net::Cmd: bound response buffers to prevent memory-exhaustion DoS
+# a6caebda Ensure that $partial cannot overshoot its limit
+# b6fa2edf Switch hard-coded constant limits to overridable methods
+#
+# Three sinks are tested:
+#
+# 1. getline()/partial-line accumulator (max_partial_bytes, default 1 MiB)
+# 2. response() multiline accumulator (max_resp_bytes, default 8 MiB)
+# 3. read_until_dot() body accumulator (max_dotread_bytes, default 32 MiB)
+#
+# To keep the tests fast and deterministic the limits are overridden to small
+# values via subclassing (the overridable-methods feature from b6fa2edf).
+# A socketpair feeds pre-crafted "server" bytes into the real Net::Cmd code.
+#
+# Design note: getline() reads up to 1024 bytes per sysread() call, and the
+# partial-line check fires on length($partial) + length($sysread_buf). So
+# max_partial_bytes must always be >= 1024 for tests that are NOT testing the
+# partial-line guard itself, otherwise the partial check fires first and masks
+# the response()/read_until_dot() overflow paths. TestCmd uses 4096 as its
+# default so that response() and read_until_dot() tests are unaffected, while
+# the partial-line section uses dedicated subclasses with much smaller limits.
+#
+# COPYRIGHT
+# Copyright (C) 2026 Steve Hay. All rights reserved.
+#
+# LICENCE
+# This script is free software; you can redistribute it and/or modify it under
+# the same terms as Perl itself, i.e. under the terms of either the GNU
+# General Public License or the Artistic License, as specified in the LICENCE
+# file.
+#
+#===============================================================================
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use IO::Handle qw();
+use Net::Cmd qw();
+use Socket qw(AF_UNIX SOCK_STREAM);
+use Test::More;
+
+#===============================================================================
+# INITIALIZATION
+#===============================================================================
+
+BEGIN {
+ if (!eval { require Socket }) {
+ plan skip_all => "no Socket";
+ }
+ elsif (!eval { Socket->import(qw(AF_UNIX SOCK_STREAM)); 1 }) {
+ plan skip_all => "Socket does not export AF_UNIX/SOCK_STREAM";
+ }
+ elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) {
+ plan skip_all => "EBCDIC but no Convert::EBCDIC";
+ }
+ else {
+ my ($rd, $wr);
+ if (!socketpair($rd, $wr, AF_UNIX, SOCK_STREAM, 0)) {
+ plan skip_all => "socketpair not available: $!";
+ }
+ else {
+ close $rd;
+ close $wr;
+ plan tests => 28;
+ }
+ }
+}
+
+#===============================================================================
+# TEST CLASSES
+#===============================================================================
+
+# ---------------------------------------------------------------------------
+# TestCmd - base subclass for all tests.
+#
+# max_partial_bytes is set large enough (4 KiB) that normal CRLF-terminated
+# lines arriving in a single sysread() chunk do NOT trip the partial guard.
+# This lets the response() and read_until_dot() overflow paths be tested
+# independently. The partial-line section uses smaller-limit subclasses.
+# ---------------------------------------------------------------------------
+
+{
+ package TestCmd;
+ use IO::Handle;
+ use Net::Cmd;
+ our @ISA = qw(Net::Cmd IO::Handle);
+ sub new { my ($class, $fh) = @_; return bless $fh, $class }
+ sub timeout { 0 }
+ sub max_partial_bytes { 4096 } # large enough not to interfere
+ sub max_resp_bytes { 128 } # small so response() overflow is cheap
+ sub max_dotread_bytes { 256 } # small so read_until_dot() overflow is cheap
+}
+
+# Subclasses used in the partial-line section (Section 1).
+{
+ package TestCmdPartial64; # limit = 64 bytes
+ our @ISA = ('TestCmd');
+ sub max_partial_bytes { 64 }
+}
+{
+ package TestCmdPartial256; # limit = 256 bytes (raises default)
+ our @ISA = ('TestCmdPartial64');
+ sub max_partial_bytes { 256 }
+}
+{
+ package TestCmdPartial8; # limit = 8 bytes (lowers default)
+ our @ISA = ('TestCmdPartial64');
+ sub max_partial_bytes { 8 }
+}
+
+# Subclass used in the response() section (Section 2).
+{
+ package TestCmdBigResp; # raises max_resp_bytes
+ our @ISA = ('TestCmd');
+ sub max_resp_bytes { 512 }
+}
+
+# Subclass used in the read_until_dot() section (Section 3).
+{
+ package TestCmdSmallDot; # lowers max_dotread_bytes
+ our @ISA = ('TestCmd');
+ sub max_dotread_bytes { 32 }
+}
+
+#===============================================================================
+# SUBROUTINES
+#===============================================================================
+
+# ---------------------------------------------------------------------------
+# make_cmd($data [, $class])
+# Write $data to a socketpair, shut the write end, return a $class object
+# wrapping the read end.
+# ---------------------------------------------------------------------------
+
+sub make_cmd {
+ my ($server_data, $class) = @_;
+ $class = 'TestCmd' unless defined $class;
+
+ my ($rd, $wr);
+ socketpair($rd, $wr, AF_UNIX, SOCK_STREAM, 0)
+ or die "socketpair: $!";
+
+ $wr->autoflush(1);
+ print $wr $server_data;
+ shutdown($wr, 1); # SHUT_WR: reader sees EOF after all bytes
+ close $wr;
+
+ return $class->new($rd);
+}
+
+# ---------------------------------------------------------------------------
+# dot_encode(@lines) - format lines as a dot-terminated RFC 977/2449 body
+# ---------------------------------------------------------------------------
+
+sub dot_encode {
+ my @lines = @_;
+ my $out = '';
+ for my $ln (@lines) {
+ $ln =~ s/^\.\././;
+ $out .= $ln . "\015\012";
+ }
+ $out .= ".\015\012";
+ return $out;
+}
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+# ===========================================================================
+# Section 1 - getline() partial-line accumulator (max_partial_bytes)
+#
+# The partial accumulator grows when sysread() delivers bytes that contain no
+# CRLF. After each sysread the check is:
+# length($partial) + length($buf) > max_partial_bytes -> error
+# (the a6caebda fix moves this check *before* prepending $partial to $buf, so
+# the combined size is tested rather than the post-prepend remainder).
+# ===========================================================================
+
+# 1a. A line of exactly max_partial_bytes bytes + CRLF must succeed.
+# With limit=64: send 64 'A's + CRLF. The sysread delivers 66 bytes;
+# length($partial=0) + length($buf=66) = 66 > 64 -- this would fail.
+# Instead use 62 'A's + CRLF = 64 bytes total: 0 + 64 = 64, not > 64.
+{
+ # 62 data bytes + CRLF = 64 bytes in the sysread buffer.
+ # length(partial=0) + length(buf=64) = 64, which is NOT > 64, so accepted.
+ my $line = ('A' x 62) . "\015\012";
+ my $cmd = make_cmd($line, 'TestCmdPartial64');
+
+ my $got = $cmd->getline;
+ is($got, ('A' x 62) . "\n",
+ 'getline: line whose raw bytes equal max_partial_bytes is accepted');
+ is($cmd->code, 421,
+ 'getline: code is DEF_REPLY_CODE when no error has occurred');
+}
+
+# 1b. A partial line (no CRLF) one byte over the limit must close the
+# socket and set an error status.
+{
+ # 65 bytes, no CRLF: length(partial=0) + length(buf=65) = 65 > 64.
+ my $data = 'A' x 65;
+ my $cmd = make_cmd($data, 'TestCmdPartial64');
+
+ my $got = $cmd->getline;
+ ok(!defined $got,
+ 'getline: oversized partial returns undef');
+ is($cmd->code, 421,
+ 'getline: code is 421 after partial-line overflow');
+ like(($cmd->message)[0], qr/Response line too long/i,
+ 'getline: message says "Response line too long"');
+ ok(!defined fileno($cmd),
+ 'getline: connection is closed after overflow');
+}
+
+# 1c. The a6caebda fix: the check fires on the *combined* size before prepend,
+# so even a single oversized chunk is caught on the first sysread.
+{
+ # Same 65-byte payload; verifies the pre-prepend path specifically.
+ my $data = 'B' x 65;
+ my $cmd = make_cmd($data, 'TestCmdPartial64');
+
+ my $got = $cmd->getline;
+ ok(!defined $got,
+ 'getline (a6caebda): pre-prepend check fires on first oversized read');
+ like(($cmd->message)[0], qr/Response line too long/i,
+ 'getline (a6caebda): correct error message');
+}
+
+# 1d. Subclass that raises max_partial_bytes allows a longer partial/line.
+{
+ # 128 bytes of data + CRLF = 130 bytes: > 64 (TestCmdPartial64) but < 256.
+ my $line = ('C' x 128) . "\015\012";
+ my $cmd = make_cmd($line, 'TestCmdPartial256');
+
+ my $got = $cmd->getline;
+ is($got, ('C' x 128) . "\n",
+ 'getline: subclass can raise max_partial_bytes');
+}
+
+# 1e. Subclass that lowers max_partial_bytes catches a shorter overflow.
+{
+ # 9 bytes, no CRLF: 0 + 9 = 9 > 8 (TestCmdPartial8).
+ my $data = 'D' x 9;
+ my $cmd = make_cmd($data, 'TestCmdPartial8');
+
+ my $got = $cmd->getline;
+ ok(!defined $got,
+ 'getline: subclass can lower max_partial_bytes');
+ like(($cmd->message)[0], qr/Response line too long/i,
+ 'getline: lowered limit gives correct error message');
+}
+
+# ===========================================================================
+# Section 2 - response() multiline accumulator (max_resp_bytes)
+#
+# Each continuation line (NNN-...) is counted; when the running total exceeds
+# max_resp_bytes the connection is closed and CMD_ERROR is returned.
+# ===========================================================================
+
+# 2a. A short single-line response must be accepted.
+{
+ my $cmd = make_cmd("200 OK\015\012");
+
+ my $ret = $cmd->response;
+ is($ret, Net::Cmd::CMD_OK(),
+ 'response: short single-line 200 OK is accepted');
+ is($cmd->code, '200',
+ 'response: code parsed correctly');
+}
+
+# 2b. A multiline response whose total byte count exceeds max_resp_bytes must
+# return CMD_ERROR, set code 421, and close the connection.
+#
+# Note: response() counts the bytes of $str *after* parse_response() has
+# stripped the leading "NNN " / "NNN-" prefix. So "200-EEEEEEEEEEEEEEE\r\n"
+# contributes only "EEEEEEEEEEEEEEE\n" = 16 bytes per line. We need
+# 128 / 16 = 8 lines to hit the ceiling; use 10 to cross it comfortably.
+{
+ # Each continuation contributes 16 bytes after prefix stripping;
+ # 10 lines = 160 bytes > 128-byte limit.
+ my $cont = "200-" . ('E' x 15) . "\015\012";
+ my $final = "200 end\015\012";
+ my $data = ($cont x 10) . $final;
+
+ my $cmd = make_cmd($data);
+ my $ret = $cmd->response;
+
+ is($ret, Net::Cmd::CMD_ERROR(),
+ 'response: oversized multiline response returns CMD_ERROR');
+ is($cmd->code, 421,
+ 'response: code is 421 after multiline overflow');
+ like(($cmd->message)[0], qr/Response too large/i,
+ 'response: message says "Response too large"');
+ ok(!defined fileno($cmd),
+ 'response: connection is closed after overflow');
+}
+
+# 2c. A multiline response just under the limit must be accepted.
+{
+ # Two 60-byte lines = 120 bytes total, below the 128-byte limit.
+ my $line1 = "200-" . ('F' x 55) . "\015\012"; # 60 bytes
+ my $line2 = "200 " . ('F' x 55) . "\015\012"; # 60 bytes
+ my $cmd = make_cmd($line1 . $line2);
+
+ my $ret = $cmd->response;
+ is($ret, Net::Cmd::CMD_OK(),
+ 'response: multiline response within limit is accepted');
+}
+
+# 2d. Subclass that raises max_resp_bytes allows a larger multiline response.
+{
+ # 10 continuation lines x 20 bytes = 200 bytes -- over default 128 but < 512.
+ my $cont = "200-" . ('G' x 15) . "\015\012";
+ my $final = "200 end\015\012";
+ my $data = ($cont x 10) . $final;
+
+ my $cmd = make_cmd($data, 'TestCmdBigResp');
+ my $ret = $cmd->response;
+ is($ret, Net::Cmd::CMD_OK(),
+ 'response: subclass can raise max_resp_bytes');
+}
+
+# ===========================================================================
+# Section 3 - read_until_dot() body accumulator (max_dotread_bytes)
+#
+# Lines accumulate in an in-memory array when no filehandle is given; when the
+# running total exceeds max_dotread_bytes the connection is closed.
+# When a filehandle IS given the accumulator is bypassed completely.
+# ===========================================================================
+
+# 3a. A body within max_dotread_bytes must be returned as an arrayref.
+{
+ # 5 lines x 20 data bytes each; dot_encode appends \015\012, so each
+ # stored line is "HHHH...\n" = 21 bytes; total = 105 bytes < 256.
+ my $body = dot_encode(map { 'H' x 20 } 1 .. 5);
+ my $cmd = make_cmd($body);
+
+ my $arr = $cmd->read_until_dot;
+ ok(defined $arr && ref($arr) eq 'ARRAY',
+ 'read_until_dot: body within limit returns arrayref');
+ is(scalar @{$arr}, 5,
+ 'read_until_dot: correct number of lines returned');
+}
+
+# 3b. A body exceeding max_dotread_bytes must return undef, set code 421,
+# and close the connection.
+{
+ # 14 lines x 21 bytes = 294 bytes > 256-byte limit.
+ my $body = dot_encode(map { 'I' x 20 } 1 .. 14);
+ my $cmd = make_cmd($body);
+
+ my $arr = $cmd->read_until_dot;
+ ok(!defined $arr,
+ 'read_until_dot: oversized body returns undef');
+ is($cmd->code, 421,
+ 'read_until_dot: code is 421 after dot-read overflow');
+ like(($cmd->message)[0], qr/Dot-read too large/i,
+ 'read_until_dot: message says "Dot-read too large"');
+ ok(!defined fileno($cmd),
+ 'read_until_dot: connection is closed after overflow');
+}
+
+# 3c. When a filehandle is supplied the in-memory accumulator is bypassed,
+# so even a body that would overflow the byte limit must succeed.
+{
+ require File::Temp;
+
+ # 14 lines x 21 bytes = 294 bytes -- would exceed the 256-byte in-memory
+ # limit, but the data is written to the filehandle instead.
+ my $body = dot_encode(map { 'J' x 20 } 1 .. 14);
+ my $cmd = make_cmd($body);
+
+ my $fh = File::Temp->new;
+ my $arr = $cmd->read_until_dot($fh);
+
+ # Returns [] (empty arrayref) because nothing was pushed to $arr.
+ ok(defined $arr && ref($arr) eq 'ARRAY',
+ 'read_until_dot: filehandle path bypasses in-memory limit');
+}
+
+# 3d. Subclass that lowers max_dotread_bytes catches a smaller body.
+{
+ # 2 lines x 21 bytes = 42 bytes > TestCmdSmallDot's 32-byte limit.
+ my $body = dot_encode(map { 'K' x 20 } 1 .. 2);
+ my $cmd = make_cmd($body, 'TestCmdSmallDot');
+
+ my $arr = $cmd->read_until_dot;
+ ok(!defined $arr,
+ 'read_until_dot: subclass can lower max_dotread_bytes');
+ like(($cmd->message)[0], qr/Dot-read too large/i,
+ 'read_until_dot: lowered limit gives correct error message');
+}
+
+#===============================================================================