From 52229f6c5fa7e619b7483e143da3ac2674abe1da Mon Sep 17 00:00:00 2001
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Date: Thu, 29 Apr 2021 02:11:44 +0900
Subject: [PATCH] fix heuristics for setsockopt's OPTVAL argument

pp_ssockopt used to treat its last argument (OPTVAL) as a packed string
whenever it has string slot set (SvPOKp), but this would be confused
if the argument is an integer but had cached stringified value.
Now it will treat OPTVAL as a packed string only when it does not
contain any valid public numeric value.

Will fix GH #18642.
---
 pp_sys.c      |  2 +-
 t/io/socket.t | 26 ++++++++++++++++++++++++++
 2 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/pp_sys.c b/pp_sys.c
index 7d0af1f43e5c..e398ffe69e19 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2707,7 +2707,7 @@ PP(pp_ssockopt)
     case OP_SSOCKOPT: {
             const char *buf;
             int aint;
-            if (SvPOKp(sv)) {
+            if (SvPOKp(sv) && !SvNIOK(sv)) {
                 STRLEN l;
                 buf = SvPV_const(sv, l);
                 len = l;
diff --git a/t/io/socket.t b/t/io/socket.t
index 2dce1a7d08c1..707492f74c03 100644
--- a/t/io/socket.t
+++ b/t/io/socket.t
@@ -281,6 +281,32 @@ SKIP: {
     ), "0\n", {}, "fresh socket not inherited across exec");
 }
 
+# GH #18642 - test whether setsockopt works with a numeric OPTVAL which also
+# has a cached stringified value
+SKIP: {
+    defined(my $IPPROTO_IP = eval { Socket::IPPROTO_IP() })
+        or skip 'no IPPROTO_IP', 4;
+    defined(my $IP_TTL = eval { Socket::IP_TTL() })
+        or skip 'no IP_TTL', 4;
+
+    my $sock;
+    socket($sock, PF_INET, SOCK_STREAM, $tcp) or BAIL_OUT "socket: $!";
+
+    my $ttl = 7;
+    my $integer_only_ttl = 0 + $ttl;
+    ok(setsockopt($sock, $IPPROTO_IP, $IP_TTL, $integer_only_ttl),
+       'setsockopt with an integer-only OPTVAL');
+    my $set_ttl = getsockopt($sock, $IPPROTO_IP, $IP_TTL);
+    is(unpack('i', $set_ttl // ''), $ttl, 'TTL set to desired value');
+
+    my $also_string_ttl = $ttl;
+    my $string = "$also_string_ttl";
+    ok(setsockopt($sock, $IPPROTO_IP, $IP_TTL, $also_string_ttl),
+       'setsockopt with an integer OPTVAL with stringified value');
+    $set_ttl = getsockopt($sock, $IPPROTO_IP, $IP_TTL);
+    is(unpack('i', $set_ttl // ''), $ttl, 'TTL set to desired value');
+}
+
 done_testing();
 
 my @child_tests;