This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Implement grok_atou as safe/strict atoi replacement.
authorJarkko Hietaniemi <jhi@iki.fi>
Mon, 21 Jul 2014 14:41:20 +0000 (10:41 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Wed, 23 Jul 2014 01:31:41 +0000 (21:31 -0400)
For earlier discussion, see:
http://www.nntp.perl.org/group/perl.perl5.porters/2013/10/msg208680.html
https://rt.perl.org/Public/Bug/Display.html?id=116118#txn-1250187

grok_atou is completely new code, instead of trying to bolt
new parameters/flags to grok_number.  This makes it easier to
be extremely strict, and not worry about breaking grok_number.

embed.fnc
embed.h
numeric.c
perl.h
proto.h

index 241a769..d02e555 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -807,6 +807,7 @@ Apd |int    |grok_number    |NN const char *pv|STRLEN len|NULLOK UV *valuep
 Apd    |int    |grok_number_flags|NN const char *pv|STRLEN len|NULLOK UV *valuep|U32 flags
 ApdR   |bool   |grok_numeric_radix|NN const char **sp|NN const char *send
 Apd    |UV     |grok_oct       |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result
+Apdn   |Size_t         |grok_atou      |NN const char* pv|NULLOK const char** endptr
 : These are all indirectly referenced by globals.c. This is somewhat annoying.
 p      |int    |magic_clearenv |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_clear_all_env|NN SV* sv|NN MAGIC* mg
diff --git a/embed.h b/embed.h
index efa1735..7ca719d 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define getcwd_sv(a)           Perl_getcwd_sv(aTHX_ a)
 #define gp_free(a)             Perl_gp_free(aTHX_ a)
 #define gp_ref(a)              Perl_gp_ref(aTHX_ a)
+#define grok_atou              Perl_grok_atou
 #define grok_bin(a,b,c,d)      Perl_grok_bin(aTHX_ a,b,c,d)
 #define grok_hex(a,b,c,d)      Perl_grok_hex(aTHX_ a,b,c,d)
 #define grok_number(a,b,c)     Perl_grok_number(aTHX_ a,b,c)
index 4876ece..d997d11 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -786,6 +786,80 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
   return 0;
 }
 
+/*
+=for perlapi
+
+grok_atou is a safer replacement for atoi.
+
+(atoi has severe problems with illegal inputs, and should not be used.
+atoi is also affected by locale settings, which can be seen as a bug.)
+
+Returns the unsigned value, if a valid one can be parsed.
+
+Only the decimal digits '0'..'9' are accepted.
+
+Does NOT allow optional leading whitespace, as opposed to atoi.
+
+On return the *endptr will contain the pointer to the first non-digit byte.
+
+If the value overflows, returns Size_t_MAX, and sets the *endptr
+to NULL, unless endptr is NULL.
+
+If the endptr is NULL, the first non-digit byte MUST be
+the zero byte terminating the pv, or either zero or Size_t_MAX
+will be returned, as appropriate.
+
+=cut
+*/
+
+Size_t
+Perl_grok_atou(const char *pv, const char** endptr)
+{
+    const char* s = pv;
+    const char** eptr;
+    const char* end2; /* Used in case endptr is NULL. */
+    Size_t val = 0; /* The return value. */
+
+    PERL_ARGS_ASSERT_GROK_ATOU;
+
+    eptr = endptr ? endptr : &end2;
+    if (isDIGIT(*s) && !isDIGIT(*(s + 1))) {
+        /* Quite common cases, and in addition the case of zero ("0")
+         * simplifies the decoding loop: not having to think whether
+         * "000" or "000123" are valid (now they are invalid). */
+        val = *s++ - '0';
+    } else {
+        Size_t tmp = 0; /* Temporary accumulator. */
+
+        while (*s) {
+            /* This could be unrolled like in grok_number(), but
+             * the expected uses of this are not speed-needy, and
+             * unlikely to need 64-bitness. */
+            if (isDIGIT(*s)) {
+                int digit = *s++ - '0';
+                tmp = tmp * 10 + digit;
+                if (tmp > val) { /* Rejects leading zeros. */
+                    val = tmp;
+                } else { /* Overflow. */
+                    *eptr = NULL;
+                    return Size_t_MAX;
+                }
+            } else {
+                break;
+            }
+        }
+        if (s == pv) {
+            *eptr = NULL; /* If no progress, failed to parse anything. */
+            return 0;
+        }
+    }
+    if (endptr == NULL && *s) {
+        return 0; /* If endptr is NULL, no trailing non-digits allowed. */
+    }
+    *eptr = s;
+    return val;
+}
+
 STATIC NV
 S_mulexp10(NV value, I32 exponent)
 {
diff --git a/perl.h b/perl.h
index 54f6dca..202e55e 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1677,7 +1677,8 @@ typedef UVTYPE UV;
 #  endif
 #endif
 
-#define SSize_t_MAX (SSize_t)(~(size_t)0 >> 1)
+#define Size_t_MAX (~(Size_t)0)
+#define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1)
 
 #define IV_DIG (BIT_DIGITS(IVSIZE * 8))
 #define UV_DIG (BIT_DIGITS(UVSIZE * 8))
diff --git a/proto.h b/proto.h
index 49a44d2..1eccc46 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1289,6 +1289,11 @@ PERL_CALLCONV int        Perl_getcwd_sv(pTHX_ SV* sv)
 
 PERL_CALLCONV void     Perl_gp_free(pTHX_ GV* gv);
 PERL_CALLCONV GP*      Perl_gp_ref(pTHX_ GP* gp);
+PERL_CALLCONV Size_t   Perl_grok_atou(const char* pv, const char** endptr)
+                       __attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_GROK_ATOU     \
+       assert(pv)
+
 PERL_CALLCONV UV       Perl_grok_bin(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)