APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1506246212 -3600 # Sun Sep 24 10:43:32 2017 +0100 # Node ID 0d158ce025013acbf1023cfb86be2fde9c495a84 # Parent dfe676a17ebadf7f07b8b5afb67f38e30fc65400 Error when passed lengths that would overflow, #'make-vector, #'make-string src/ChangeLog addition: 2017-09-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; Error when passed values that would overflow, #'make-vector, #'make-string, #'make-bit-vector * lisp.h: Make ARRAY_DIMENSION_LIMIT more realistic; provide analagous but larger STRING_BYTE_TOTAL_SIZE_LIMIT, BIT_VECTOR_TOTAL_SIZE_LIMIT. * lisp.h (struct Lisp_Vector): SIZE is now an Elemcount, not a long. * alloc.c: Provide Vstring_total_size_limit, Vbit_vector_total_size_limit. * alloc.c (make_uninit_vector): Do our size calculation with EMACS_UINT; assert we haven't overflowed. * alloc.c (Fmake_vector): Check LENGTH for range more correctly. * alloc.c (Fvector): Check NARGS for range. * alloc.c (make_bit_vector_internal): Document why we don't need to check SIZEI for range in this function. * alloc.c (make_bit_vector_from_byte_vector): Check the range here, no point creating a bit vector where the trailing elements can't be referenced from Lisp. * alloc.c (Fmake_bit_vector): Check LENGTH using BIT_VECTOR_TOTAL_SIZE_LIMIT; check that BIT is a bit before allocating anything. * alloc.c (Fbit_vector): Check NARGS for range. * alloc.c (make_uninit_string): Do the length calculation and overflow assertion check with EMACS_UINTs, so GCC doesn't eliminate the check when optimising. * alloc.c (Fmake_string): Check LENGTH for possible overflow in this function. * alloc.c (Fstring): Check NARGS for possible overflow in this function. * alloc.c (vars_of_alloc): Provide, document `string-total-size-limit', `bit-vector-total-size-limit'. * event-stream.c (Frecent_keys): Use ARRAY_DIMENSION_LIMIT correctly here. * sequence.c (concatenate): Check for overflow before allocating strings, vectors, using unsigned arithmetic so GCC doesn't optimize away signed checks. tests/ChangeLog addition: 2017-09-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el: Basic checks that array-total-size-limit, bit-vector-total-size-limit, string-total-size-limit are respected. diff -r dfe676a17eba -r 0d158ce02501 src/ChangeLog --- a/src/ChangeLog Sun Sep 24 09:16:02 2017 +0100 +++ b/src/ChangeLog Sun Sep 24 10:43:32 2017 +0100 ＠＠ -1,3 +1,49 ＠＠ +2017-09-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + Error when passed values that would overflow, #'make-vector, + #'make-string, #'make-bit-vector + * lisp.h: + Make ARRAY_DIMENSION_LIMIT more realistic; provide analagous + but larger STRING_BYTE_TOTAL_SIZE_LIMIT, + BIT_VECTOR_TOTAL_SIZE_LIMIT. + * lisp.h (struct Lisp_Vector): + SIZE is now an Elemcount, not a long. + * alloc.c: + Provide Vstring_total_size_limit, Vbit_vector_total_size_limit. + * alloc.c (make_uninit_vector): + Do our size calculation with EMACS_UINT; assert we haven't + overflowed. + * alloc.c (Fmake_vector): + Check LENGTH for range more correctly. + * alloc.c (Fvector): + Check NARGS for range. + * alloc.c (make_bit_vector_internal): + Document why we don't need to check SIZEI for range in this + function. + * alloc.c (make_bit_vector_from_byte_vector): + Check the range here, no point creating a bit vector where the + trailing elements can't be referenced from Lisp. + * alloc.c (Fmake_bit_vector): + Check LENGTH using BIT_VECTOR_TOTAL_SIZE_LIMIT; check that BIT is + a bit before allocating anything. + * alloc.c (Fbit_vector): + Check NARGS for range. + * alloc.c (make_uninit_string): + Do the length calculation and overflow assertion check with + EMACS_UINTs, so GCC doesn't eliminate the check when optimising. + * alloc.c (Fmake_string): + Check LENGTH for possible overflow in this function. + * alloc.c (Fstring): + Check NARGS for possible overflow in this function. + * alloc.c (vars_of_alloc): + Provide, document `string-total-size-limit', + `bit-vector-total-size-limit'. + * event-stream.c (Frecent_keys): + Use ARRAY_DIMENSION_LIMIT correctly here. + * sequence.c (concatenate): + Check for overflow before allocating strings, vectors, using + unsigned arithmetic so GCC doesn't optimize away signed checks. + 2017-09-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; * symbols.c (do_symval_forwarding): diff -r dfe676a17eba -r 0d158ce02501 src/alloc.c --- a/src/alloc.c Sun Sep 24 09:16:02 2017 +0100 +++ b/src/alloc.c Sun Sep 24 10:43:32 2017 +0100 ＠＠ -95,6 +95,7 ＠＠ #endif Fixnum Varray_dimension_limit, Varray_total_size_limit, Varray_rank_limit; +Fixnum Vstring_total_size_limit, Vbit_vector_total_size_limit; int need_to_check_c_alloca; int need_to_signal_post_gc; ＠＠ -1864,11 +1865,16 ＠＠ make_uninit_vector (Elemcount sizei) { /* no `next' field; we use lcrecords */ - Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, - contents, sizei); - Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, vector); - Lisp_Vector *p = XVECTOR (obj); - + EMACS_UINT sizeui = sizei; + EMACS_UINT sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, + contents, sizeui); + Lisp_Object obj; + Lisp_Vector *p; + + structure_checking_assert (sizem >= sizeui); + + obj = ALLOC_SIZED_LISP_OBJECT (sizem, vector); + p = XVECTOR (obj); p->size = sizei; return obj; } ＠＠ -1891,7 +1897,10 ＠＠ */ (length, object)) { - check_integer_range (length, Qzero, make_fixnum (ARRAY_DIMENSION_LIMIT)); + check_integer_range (length, Qzero, + /* array-dimension-limit is an exclusive upper bound, + check_integer_range() does <=, adjust for this. */ + make_fixnum (ARRAY_DIMENSION_LIMIT - 1)); return make_vector (XFIXNUM (length), object); } ＠＠ -1903,7 +1912,12 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object result = make_uninit_vector (nargs); + Lisp_Object result; + check_integer_range (make_fixnum (nargs), Qzero, + /* array-dimension-limit is an exclusive upper bound, + check_integer_range() does <=, adjust for this. */ + make_fixnum (ARRAY_DIMENSION_LIMIT - 1)); + result = make_uninit_vector (nargs); memcpy (XVECTOR_DATA (result), args, sizeof (Lisp_Object) * nargs); return result; } ＠＠ -2135,6 +2149,9 ＠＠ Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits, num_longs); + /* No need to do the overflow checks we do for vectors and strings, for + large values of SIZEI the number of longs is always going to be less than + SIZEI, the number of bits. */ Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, bit_vector); Lisp_Bit_Vector *p = XBIT_VECTOR (obj); ＠＠ -2169,7 +2186,12 ＠＠ make_bit_vector_from_byte_vector (unsigned char *bytevec, Elemcount length) { Elemcount i; - Lisp_Bit_Vector *p = make_bit_vector_internal (length); + Lisp_Bit_Vector *p; + + check_integer_range (make_integer (length), Qzero, + make_fixnum (BIT_VECTOR_TOTAL_SIZE_LIMIT - 1)); + + p = make_bit_vector_internal (length); for (i = 0; i < length; i++) set_bit_vector_bit (p, i, bytevec[i]); ＠＠ -2194,7 +2216,9 ＠＠ */ (length, bit)) { - check_integer_range (length, Qzero, make_fixnum (ARRAY_DIMENSION_LIMIT)); + check_integer_range (length, Qzero, + make_fixnum (BIT_VECTOR_TOTAL_SIZE_LIMIT - 1)); + CHECK_BIT (bit); return make_bit_vector (XFIXNUM (length), bit); } ＠＠ -2208,7 +2232,11 ＠＠ (int nargs, Lisp_Object *args)) { int i; - Lisp_Bit_Vector *p = make_bit_vector_internal (nargs); + Lisp_Bit_Vector *p; + + check_integer_range (make_fixnum (nargs), Qzero, + make_fixnum (BIT_VECTOR_TOTAL_SIZE_LIMIT - 1)); + p = make_bit_vector_internal (nargs); for (i = 0; i < nargs; i++) { ＠＠ -2944,10 +2972,11 ＠＠ Lisp_Object make_uninit_string (Bytecount length) { + EMACS_UINT ulength = length, fullsize = STRING_FULLSIZE (ulength); Lisp_String *s; - Bytecount fullsize = STRING_FULLSIZE (length); - - assert (length >= 0 && fullsize > 0); + + structure_checking_assert (length >= 0 && fullsize >= ulength + && ((Bytecount) fullsize) >= 0); #ifdef NEW_GC s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string)); ＠＠ -3228,43 +3257,90 ＠＠ DEFUN ("make-string", Fmake_string, 2, 2, 0, /* Return a new string consisting of LENGTH copies of CHARACTER. LENGTH must be a non-negative integer. +See the variable `string-total-size-limit' for restrictions on LENGTH. */ (length, character)) { - check_integer_range (length, Qzero, make_fixnum (ARRAY_DIMENSION_LIMIT)); + Ibyte init_str[MAX_ICHAR_LEN]; + Bytecount onelen; + Lisp_Object val; + CHECK_CHAR_COERCE_INT (character); - { - Ibyte init_str[MAX_ICHAR_LEN]; - int len = set_itext_ichar (init_str, XCHAR (character)); - Lisp_Object val = make_uninit_string (len * XFIXNUM (length)); - - if (len == 1) - { - /* Optimize the single-byte case */ - memset (XSTRING_DATA (val), XCHAR (character), XSTRING_LENGTH (val)); - XSET_STRING_ASCII_BEGIN (val, min (MAX_STRING_ASCII_BEGIN, - len * XFIXNUM (length))); - } - else - { - EMACS_INT i; - Ibyte *ptr = XSTRING_DATA (val); - - for (i = XFIXNUM (length); i; i--) - { - Ibyte *init_ptr = init_str; - switch (len) - { - case 4: *ptr++ = *init_ptr++; - case 3: *ptr++ = *init_ptr++; - case 2: *ptr++ = *init_ptr++; - case 1: *ptr++ = *init_ptr++; - } - } - } - sledgehammer_check_ascii_begin (val); - return val; - } + onelen = set_itext_ichar (init_str, XCHAR (character)); + + if (onelen == 1) + { + /* Optimize the single-byte case */ + check_integer_range (length, Qzero, + /* Exclusive upper bound, but check_integer_range() + is inclusive. */ + make_fixnum (STRING_BYTE_TOTAL_SIZE_LIMIT - 1)); + + val = make_uninit_string (XFIXNUM (length)); + memset (XSTRING_DATA (val), XCHAR (character), XSTRING_LENGTH (val)); + XSET_STRING_ASCII_BEGIN (val, min (MAX_STRING_ASCII_BEGIN, + XSTRING_LENGTH (val))); + } + else if (FIXNUMP (length) && XREALFIXNUM (length) >= 0) + { + EMACS_UINT clen = XREALFIXNUM (length); + EMACS_UINT oproduct = clen, product = clen, fsize; + EMACS_INT i; + Ibyte *ptr; + + for (i = onelen, --i; i; i--) + { + product += clen; + if (product < oproduct) + { + /* We're adding, not multiplying, because it's far harder to + detect overflow when you multiply MOST_POSITIVE_FIXNUM by six + on 32-bit platforms; you get a number greater than + MOST_POSITIVE_FIXNUM that is still less than the number you + want. */ + goto range_issue; + } + oproduct = product; + } + + if ((fsize = STRING_FULLSIZE (product)) < oproduct + || ((Bytecount) fsize < 0)) + { + goto range_issue; + } + + val = make_uninit_string ((Bytecount) product); + ptr = XSTRING_DATA (val); + + for (i = clen; i; i--) + { + Ibyte *init_ptr = init_str; + switch (onelen) + { +#if MAX_ICHAR_LEN > 6 +#error "unimplemented" +#elif MAX_ICHAR_LEN > 4 + case 6: *ptr++ = *init_ptr++; + case 5: *ptr++ = *init_ptr++; +#endif + case 4: *ptr++ = *init_ptr++; + case 3: *ptr++ = *init_ptr++; + case 2: *ptr++ = *init_ptr++; + case 1: *ptr++ = *init_ptr++; + } + } + } + else + { + range_issue: + check_integer_range (length, Qzero, + make_fixnum ((STRING_BYTE_TOTAL_SIZE_LIMIT - 1) / + onelen)); + return Qnil; + } + + sledgehammer_check_ascii_begin (val); + return val; } DEFUN ("string", Fstring, 0, MANY, 0, /* ＠＠ -3274,8 +3350,15 ＠＠ */ (int nargs, Lisp_Object *args)) { - Ibyte *storage = alloca_ibytes (nargs * MAX_ICHAR_LEN); - Ibyte *p = storage; + Ibyte *storage, *p; + + /* No need to work too hard at this overflow check, it will be very rare + that NARGS will be greater than #x10000. */ + check_integer_range (make_fixnum (nargs), Qzero, + make_fixnum ((STRING_BYTE_TOTAL_SIZE_LIMIT - 1) / + MAX_ICHAR_LEN)); + + storage = p = alloca_ibytes (nargs * MAX_ICHAR_LEN); for (; nargs; nargs--, args++) { ＠＠ -6159,11 +6242,36 ＠＠ and multi-dimensional arrays need to be implemented by the user with arrays of arrays. -Note that XEmacs may not have enough memory available to create an array -with this dimension. +This limit is a result of the bit widths used in the implementation of the +`vector' type. Note that XEmacs may not have enough memory available to create +an array with this number of elements. */); Varray_total_size_limit = ARRAY_DIMENSION_LIMIT; + DEFVAR_CONST_INT ("string-total-size-limit", &Vstring_total_size_limit /* +The exclusive upper bound on a string's length. + +This is usually significantly more than `array-total-size-limit'. +Exclusively-ASCII strings can approach this limit in terms of their character +count, but strings with significant non-ASCII content are more restricted, +since each non-ASCII character takes more byte space than does an ASCII +character. + +This limit is a result of the range limitations on arguments to `aref' and +`aset', and the amount of memory available to XEmacs is a separate question. +*/); + Vstring_total_size_limit = STRING_BYTE_TOTAL_SIZE_LIMIT; + + DEFVAR_CONST_INT ("bit-vector-total-size-limit", + &Vbit_vector_total_size_limit /* +The exclusive upper bound on a bit vector's length. + +This limit is a result of the range limitations on arguments to `aref' and +`aset'. As with any operation that allocates memory, it is possible for +`make-bit-vector' to fail if there is insufficient memory available to XEmacs. +*/); + Vbit_vector_total_size_limit = BIT_VECTOR_TOTAL_SIZE_LIMIT; + #ifdef DEBUG_XEMACS DEFVAR_INT ("debug-allocation", &debug_allocation /* If non-zero, print out information to stderr about all objects allocated. diff -r dfe676a17eba -r 0d158ce02501 src/event-stream.c --- a/src/event-stream.c Sun Sep 24 09:16:02 2017 +0100 +++ b/src/event-stream.c Sun Sep 24 10:43:32 2017 +0100 ＠＠ -3801,7 +3801,10 ＠＠ else { check_integer_range (number, Qzero, - make_fixnum (ARRAY_DIMENSION_LIMIT)); + /* array-dimension-limit is an exclusive upper + bound, check_integer_range() does <=, adjust for + this. */ + make_fixnum (ARRAY_DIMENSION_LIMIT - 1)); nwanted = XFIXNUM (number); } diff -r dfe676a17eba -r 0d158ce02501 src/lisp.h --- a/src/lisp.h Sun Sep 24 09:16:02 2017 +0100 +++ b/src/lisp.h Sun Sep 24 10:43:32 2017 +0100 ＠＠ -2851,7 +2851,7 ＠＠ struct Lisp_Vector { NORMAL_LISP_OBJECT_HEADER header; - long size; + Elemcount size; Lisp_Object contents[1]; }; typedef struct Lisp_Vector Lisp_Vector; ＠＠ -4412,8 +4412,26 ＠＠ void disksave_object_finalization (void); void finish_object_memory_usage_stats (void); extern int purify_flag; -#define ARRAY_DIMENSION_LIMIT MOST_POSITIVE_FIXNUM -extern Fixnum Varray_dimension_limit; + +/* ALLOC_SIZED_LISP_OBJECT() takes a signed Bytecount, and so the limitation + on the size of a vector is that number that would cause a signed Bytecount + to overflow, when plugged into FLEXIBLE_ARRAY_STRUCT_SIZEOF(). */ +#define ARRAY_DIMENSION_LIMIT ((MOST_POSITIVE_FIXNUM / sizeof (Lisp_Object)) \ + - (offsetof (Lisp_Vector, contents) \ + / sizeof (Lisp_Object)) + 1) + +/* String lengths are less restrictive, since there's no multiplication needed + in the calculation of the Bytecount. This is an exclusive bound. */ +#define STRING_BYTE_TOTAL_SIZE_LIMIT (MOST_POSITIVE_FIXNUM + 1) + +/* This could be even less restrictive than its string counterpart. We would + need to allow bignum string indices for that, which we currently reject in + #'aset, #'aref. */ +#define BIT_VECTOR_TOTAL_SIZE_LIMIT (MOST_POSITIVE_FIXNUM + 1) + +extern Fixnum Varray_dimension_limit, Vstring_total_size_limit; +extern Fixnum Vfixnum_total_size_limit; + #ifndef NEW_GC extern EMACS_INT gc_generation_number[1]; #endif /* not NEW_GC */ diff -r dfe676a17eba -r 0d158ce02501 src/sequence.c --- a/src/sequence.c Sun Sep 24 09:16:02 2017 +0100 +++ b/src/sequence.c Sun Sep 24 10:43:32 2017 +0100 ＠＠ -4836,7 +4836,8 ＠＠ Lisp_Object result_type, Boolint reuse_last_listp) { Lisp_Object *lisp_staging = NULL, *lisp_cursor = NULL, result = Qnil; - Elemcount ii, jj, staging_len = 0; + Elemcount ii, jj; + EMACS_UINT staging_len = 0, olen = 0; struct gcpro gcpro1, gcpro2; /* We can GC in #'coerce, and in copy_string_extents(). Our callers don't ＠＠ -4852,7 +4853,7 ＠＠ #'byte-length)), no need for character lengths or INC_IBYTEPTR. */ if (EQ (result_type, Qstring)) { - Bytecount bstaging_len = 0; + EMACS_UINT bstaging_len = 0; Ibyte *bstaging = NULL, *cursor = NULL; struct merge_string_extents_struct *args_mse = alloca_array (struct merge_string_extents_struct, nsequences); ＠＠ -4860,6 +4861,7 ＠＠ for (ii = 0; ii < nsequences; ++ii) { + olen = bstaging_len; if (STRINGP (sequences[ii])) { bstaging_len += XSTRING_LENGTH (sequences[ii]); ＠＠ -4873,6 +4875,16 ＠＠ bstaging_len += (XFIXNUM (Flength (sequences[ii]))) * MAX_ICHAR_LEN; } + + if (bstaging_len >= STRING_BYTE_TOTAL_SIZE_LIMIT + || bstaging_len < olen) + { + invalid_argument_2 ("concatenate: length overflow", + result_type, + /* Don't pass SEQUENCES[II] to the error + handling, we don't want it printed */ + make_unsigned_integer (bstaging_len)); + } } result = make_uninit_string (bstaging_len); ＠＠ -4934,11 +4946,13 ＠＠ } } - if ((cursor - bstaging) != bstaging_len) + assert (cursor >= bstaging); + + if ((EMACS_UINT) (cursor - bstaging) != bstaging_len) { Bytecount used_len = cursor - bstaging; - text_checking_assert (used_len < bstaging_len); + text_checking_assert ((EMACS_UINT) used_len < bstaging_len); /* No-one else has a pointer to RESULT, and calling resize_string() gives crashes in temacs, its implementation isn't thoroughly ＠＠ -5030,6 +5044,7 ＠＠ for (ii = 0; ii < nsequences; ++ii) { + olen = staging_len; if (STRINGP (sequences[ii])) { /* No need to actually get the char length, since the byte length ＠＠ -5044,6 +5059,15 ＠＠ type and circularity, well-formedness. */ staging_len += (XFIXNUM (Flength (sequences[ii]))); } + + if (staging_len >= ARRAY_DIMENSION_LIMIT || staging_len < olen) + { + invalid_argument_2 ("concatenate: length overflow", + result_type, + /* Don't pass SEQUENCES[II] to the error + handling, we don't want it printed */ + make_unsigned_integer (staging_len)); + } } if (EQ (result_type, Qvector) || EQ (result_type, Qarray)) diff -r dfe676a17eba -r 0d158ce02501 tests/ChangeLog --- a/tests/ChangeLog Sun Sep 24 09:16:02 2017 +0100 +++ b/tests/ChangeLog Sun Sep 24 10:43:32 2017 +0100 ＠＠ -1,3 +1,10 ＠＠ +2017-09-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Basic checks that array-total-size-limit, + bit-vector-total-size-limit, string-total-size-limit are + respected. + 2017-05-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/os-tests.el: diff -r dfe676a17eba -r 0d158ce02501 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Sun Sep 24 09:16:02 2017 +0100 +++ b/tests/automated/lisp-tests.el Sun Sep 24 10:43:32 2017 +0100 ＠＠ -1184,6 +1184,8 ＠＠ (Assert (not (equal [1 2 3 4] [1 2 3]))) (Assert (equal (vector 1 2 3) [1 2 3])) (Assert (equal (make-vector 3 1) [1 1 1])) +(Check-Error args-out-of-range (make-vector array-total-size-limit ?a)) +(Check-Error args-out-of-range (make-vector -1 ?a)) ;;----------------------------------------------------- ;; Test bit-vector functions ＠＠ -1198,6 +1200,24 ＠＠ (Assert (equal (bit-vector 0 1 0) #*010)) (Assert (equal (make-bit-vector 3 1) #*111)) (Assert (equal (make-bit-vector 3 0) #*000)) +(Check-Error args-out-of-range (make-bit-vector bit-vector-total-size-limit 1)) +(Check-Error args-out-of-range (make-bit-vector -1 1)) +(Check-Error wrong-type-argument (make-bit-vector most-positive-fixnum -1)) + +;;----------------------------------------------------- +;; Test string functions +;;----------------------------------------------------- +(Assert (equal "abc" "abc")) +(Assert (equal "" "")) +(Assert (not (equal "abc" ""))) +(Assert (not (equal "abc" "abd"))) +(Assert (not (equal "abc" "bcd"))) +(Assert (equal (string ?a ?b ?c) "abc")) +(Assert (equal (string 1 2 3) "\x01\x02\x03")) +(Assert (equal (make-string 3 ?a) "aaa")) +(Assert (equal (make-string 3 0) "\0\0\0")) +(Check-Error args-out-of-range (make-string string-total-size-limit ?a)) +(Check-Error args-out-of-range (make-string -1 ?a)) ;;----------------------------------------------------- ;; Test buffer-local variables used as (ugh!) function parameters -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)