commit/XEmacs: kehoea: Better range checking, decoding Lisp values, for underlying C integer types

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/046a3f85a39d/ Changeset: 046a3f85a39d User: kehoea Date: 2018-04-21 15:49:20+00:00 Summary: Better range checking, decoding Lisp values, for underlying C integer types src/ChangeLog addition: 2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; * data.c: Provide macros to generalise the two-way conversion between C integer types and Lisp values (fixnums, bignums, conses of fixnums and, because GNU, floats). Use these macros to generate conversion functions for OFF_T and for uid_t. There may be scope down the line for further types, it needs looking into. * dired.c (Ffile_attributes): Use OFF_T_to_lisp here. * editfns.c: * editfns.c (Ftemp_directory): * editfns.c (Fuser_login_name): * editfns.c (Fuser_uid): * editfns.c (Fuser_real_uid): Use lisp_to_uid_t, uid_t_to_lisp as appropriate in these functions. * fileio.c: Remove the old lisp_to_off_t(). Use the new lisp_to_OFF_T. * number.h: Declare the new generated conversion functions for OFF_T and for uid_t. tests/ChangeLog addition: 2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/os-tests.el (two-to-the-thirty-second): Check that (user-login-name 4294967296) no longer gives "root", as it used to do on 64-bit builds. Affected #: 8 files diff -r 368318a5c386 -r 046a3f85a39d src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,27 ＠＠ +2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * data.c: + Provide macros to generalise the two-way conversion + between C integer types and Lisp values (fixnums, bignums, conses + of fixnums and, because GNU, floats). + Use these macros to generate conversion functions for OFF_T and + for uid_t. There may be scope down the line for further types, it + needs looking into. + * dired.c (Ffile_attributes): + Use OFF_T_to_lisp here. + * editfns.c: + * editfns.c (Ftemp_directory): + * editfns.c (Fuser_login_name): + * editfns.c (Fuser_uid): + * editfns.c (Fuser_real_uid): + Use lisp_to_uid_t, uid_t_to_lisp as appropriate in these + functions. + * fileio.c: + Remove the old lisp_to_off_t(). Use the new lisp_to_OFF_T. + * number.h: + Declare the new generated conversion functions for OFF_T and for + uid_t. + 2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; * lisp.h (NUMBER_FITS_IN_A_FIXNUM, NUMBER_FITS_IN_A_FIXNUM): diff -r 368318a5c386 -r 046a3f85a39d src/data.c --- a/src/data.c +++ b/src/data.c ＠＠ -4099,6 +4099,217 ＠＠ return EPHEMERONP (object) ? Qt : Qnil; }  +/****************** Converting to and from specific C types ******************/ + +#ifdef HAVE_BIGNUM +#define LISP_INTEGER_TO_C_TYPE(c_type, objekt) \ + if (INTEGERP (objekt)) \ + do \ + { \ + check_integer_range (objekt, make_integer (min_lisp_to_c_type), \ + make_integer (max_lisp_to_c_type)); \ + if (FIXNUMP (objekt)) \ + { \ + return (c_type) XREALFIXNUM (objekt); \ + } \ + else if (BIGNUMP (objekt)) \ + { \ + if (sizeof (c_type) >= SIZEOF_EMACS_INT && \ + bignum_fits_emacs_int_p (XBIGNUM_DATA (objekt))) \ + { \ + return (c_type) bignum_to_emacs_int (XBIGNUM_DATA \ + (objekt)); \ + } \ + \ + if (sizeof (c_type) >= sizeof (long long) && \ + bignum_fits_llong_p (XBIGNUM_DATA (objekt))) \ + { \ + return (c_type) bignum_to_llong (XBIGNUM_DATA (objekt)); \ + } \ + \ + if (sizeof (c_type) >= sizeof (long long) && \ + bignum_fits_ullong_p (XBIGNUM_DATA (objekt))) \ + { \ + return (c_type) bignum_to_ullong (XBIGNUM_DATA (objekt)); \ + } \ + \ + signal_error (Qunimplemented, \ + "cannot decode this " #c_type, \ + objekt); \ + RETURN_NOT_REACHED ((c_type) -1); \ + } \ + } while (0) +#define C_TYPE_TO_LISP_INTEGER(c_type, value)\ + return make_integer (value) +#else +#define LISP_INTEGER_TO_C_TYPE(c_type, objekt) \ + if (FIXNUMP (objekt)) \ + do \ + { \ + EMACS_INT ival = XREALFIXNUM (objekt); \ + \ + if (sizeof (c_type) >= sizeof (EMACS_INT) ? \ + ((c_type) ival < min_lisp_to_c_type || \ + (c_type) ival > max_lisp_to_c_type) : \ + (ival < (EMACS_INT) min_lisp_to_c_type || \ + ival > (EMACS_INT) max_lisp_to_c_type)) \ + { \ + args_out_of_range_3 (objekt, \ + make_float (min_lisp_to_c_type), \ + make_float (max_lisp_to_c_type)); \ + } \ + \ + return (c_type) ival; \ + } while (0) + +#define C_TYPE_TO_LISP_INTEGER(c_type, value) \ + if (NUMBER_FITS_IN_A_FIXNUM (value)) \ + { \ + return make_fixnum (value); \ + } \ + else \ + { \ + Lisp_Object result = Fcons (make_fixnum (value & 0xFFFF), Qnil); \ + Boolint negative = value < 0; \ + \ + /* Only the most significant 16 bits will be negative in the \ + constructed cons. */ \ + value = (value >> 16); \ + if (negative) \ + { \ + value = -value; \ + } \ + \ + while (value) \ + { \ + value = value >> 16; \ + result = Fcons (make_fixnum (value & 0xFFFF), result); \ + } \ + \ + if (negative) \ + { \ + XSETCAR (result, make_fixnum (- (XFIXNUM (XCAR (result))))); \ + } \ + \ + return result; \ + } \ + RETURN_NOT_REACHED ((c_type)-1) +#endif + +#define DEFINE_C_INTEGER_TYPE_LISP_CONVERSION(visibility, c_type) \ + visibility c_type \ + lisp_to_##c_type (Lisp_Object objeto) \ + { \ + c_type min_lisp_to_c_type, max_lisp_to_c_type, result = 0; \ + double dval; \ + \ + if (((c_type) -1) < 0) /* Signed type? */ \ + { \ + if (sizeof (c_type) == SIZEOF_SHORT) \ + { \ + max_lisp_to_c_type = (c_type) ((unsigned short) -1) / 2; \ + min_lisp_to_c_type \ + = (c_type) ((unsigned short)(max_lisp_to_c_type) + 1); \ + } \ + else if (sizeof (c_type) == SIZEOF_INT) \ + { \ + max_lisp_to_c_type = (c_type) ((unsigned int) -1) / 2; \ + min_lisp_to_c_type \ + = (c_type) ((unsigned int)(max_lisp_to_c_type) + 1); \ + } \ + else if (sizeof (c_type) == SIZEOF_LONG) \ + { \ + max_lisp_to_c_type = (c_type) (((unsigned long) -1) / 2); \ + min_lisp_to_c_type \ + = (c_type) ((unsigned long)(max_lisp_to_c_type) + 1); \ + } \ + else if (sizeof (c_type) == SIZEOF_LONG_LONG) \ + { \ + max_lisp_to_c_type \ + = (c_type) (((unsigned long long) -1) / 2); \ + min_lisp_to_c_type \ + = (c_type) ((unsigned long long)(max_lisp_to_c_type) + 1); \ + } \ + else \ + { \ + assert (0); /* Very very very unlikely. */ \ + } \ + } \ + else \ + { \ + min_lisp_to_c_type = 0; \ + max_lisp_to_c_type = (c_type)(-1); \ + } \ + \ + LISP_INTEGER_TO_C_TYPE (c_type, objeto); \ + \ + if (CONSP (objeto)) \ + { \ + unsigned counter = 1; \ + Lisp_Object orig = objeto; \ + \ + if ((c_type)-1 < 0) \ + { \ + check_integer_range (XCAR (objeto), make_fixnum (-32768), \ + make_fixnum (32767)); \ + } \ + else \ + { \ + check_integer_range (XCAR (objeto), Qzero, \ + make_fixnum (65535)); \ + } \ + \ + result = XFIXNUM (XCAR (objeto)); \ + objeto = XCDR (objeto); \ + \ + while (CONSP (objeto)) \ + { \ + check_integer_range (XCAR (objeto), Qzero, \ + make_fixnum (65535)); \ + counter++; \ + if (counter > sizeof (c_type) / 2) \ + { \ + invalid_argument ("Too many bits supplied " \ + "for " #c_type, \ + orig); \ + } \ + result \ + = (result << 16) | (XFIXNUM (XCAR (objeto)) & 0xFFFF); \ + objeto = XCDR (objeto); \ + } \ + \ + return result; \ + } \ + \ + dval = extract_float (objeto); \ + result = dval; \ + \ + if (result < min_lisp_to_c_type || result > max_lisp_to_c_type) \ + { \ + args_out_of_range_3 (objeto, make_float (min_lisp_to_c_type), \ + make_float (max_lisp_to_c_type)); \ + } \ + \ + if (dval != result) \ + { \ + invalid_argument ("Fractional or two wide " #c_type, \ + objeto); \ + } \ + \ + return result; \ + } \ + \ + visibility Lisp_Object \ + c_type##_to_lisp (c_type value) \ + { \ + C_TYPE_TO_LISP_INTEGER (c_type, value); \ + } \ + visibility Lisp_Object c_type##_to_lisp (c_type) + +DEFINE_C_INTEGER_TYPE_LISP_CONVERSION (extern, OFF_T); + +DEFINE_C_INTEGER_TYPE_LISP_CONVERSION (extern, uid_t); + /************************************************************************/ /* initialization */ /************************************************************************/ diff -r 368318a5c386 -r 046a3f85a39d src/dired.c --- a/src/dired.c +++ b/src/dired.c ＠＠ -838,13 +838,13 ＠＠ Lisp_Object directory = Qnil; struct stat s; char modes[10]; - Lisp_Object handler, mode, modestring = Qnil, size, gid; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object handler, mode, modestring = Qnil, size = Qzero, gid; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; Lisp_Object uidInfo = Qnil; Lisp_Object gidInfo = Qnil; - GCPRO3 (filename, directory, modestring); + GCPRO4 (filename, directory, modestring, size); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, ＠＠ -900,13 +900,7 ＠＠ #endif } -#ifndef HAVE_BIGNUM - size = make_fixnum (NUMBER_FITS_IN_A_FIXNUM (s.st_size) ? - (EMACS_INT)s.st_size : -1); -#else - size = make_integer (s.st_size); -#endif - + size = OFF_T_to_lisp (s.st_size); filemodestring (&s, modes); modestring = make_string ((Ibyte *) modes, 10); diff -r 368318a5c386 -r 046a3f85a39d src/editfns.c --- a/src/editfns.c +++ b/src/editfns.c ＠＠ -604,7 +604,7 ＠＠ if (!tmpdir) { struct stat st; - int myuid = getuid (); + uid_t myuid = getuid (); Ibyte *login_name = user_login_name (NULL); DECLARE_EISTRING (eipath); Ibyte *path; ＠＠ -614,7 +614,7 ＠＠ path = eidata (eipath); if (qxe_lstat (path, &st) < 0 && errno == ENOENT) qxe_mkdir (path, 0700); /* ignore retval -- checked next anyway. */ - if (qxe_lstat (path, &st) == 0 && (int) st.st_uid == myuid + if (qxe_lstat (path, &st) == 0 && st.st_uid == myuid && S_ISDIR (st.st_mode)) tmpdir = path; else ＠＠ -665,8 +665,7 ＠＠ if (!NILP (uid)) { - CHECK_FIXNUM (uid); - local_uid = XFIXNUM (uid); + local_uid = lisp_to_uid_t (uid); returned_name = user_login_name (&local_uid); } else ＠＠ -750,7 +749,7 ＠＠ */ ()) { - return make_fixnum (geteuid ()); + return uid_t_to_lisp (geteuid ()); } DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /* ＠＠ -758,7 +757,7 ＠＠ */ ()) { - return make_fixnum (getuid ()); + return uid_t_to_lisp (getuid ()); } DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /* diff -r 368318a5c386 -r 046a3f85a39d src/fileio.c --- a/src/fileio.c +++ b/src/fileio.c ＠＠ -166,54 +166,6 ＠＠ } return build_extstring (ret, Qstrerror_encoding); } - -static OFF_T -lisp_to_off_t (Lisp_Object offset) -{ - OFF_T result; - double v; - - if (FIXNUMP (offset)) - { - type_checking_assert (FIXNUM_VALBITS <= - (sizeof (OFF_T) * BITS_PER_CHAR)); - return XREALFIXNUM (offset); - } -#ifdef HAVE_BIGNUM - if (BIGNUMP (offset)) - { - if (bignum_fits_emacs_int_p (XBIGNUM_DATA (offset))) - { - type_checking_assert (BITS_PER_EMACS_INT <= - (sizeof (OFF_T) * BITS_PER_CHAR)); - return bignum_to_emacs_int (XBIGNUM_DATA (offset)); - } - else if (sizeof (OFF_T) == sizeof (long long) - && bignum_fits_llong_p (XBIGNUM_DATA (offset))) - { - return bignum_to_llong (XBIGNUM_DATA (offset)); - } - else if (sizeof (OFF_T) == sizeof (unsigned long long) - && (OFF_T)(-1) != -1 - && bignum_fits_ullong_p (XBIGNUM_DATA (offset))) - { - return bignum_to_ullong (XBIGNUM_DATA (offset)); - } - } -#endif - - v = extract_float (offset); - result = v; - - if (result == v) /* Value bits preserved? */ - { - return result; - } - - wtaerror ("Offset not supported", offset); - RETURN_NOT_REACHED (-1); -} -  static Lisp_Object close_file_unwind (Lisp_Object fd) ＠＠ -3025,7 +2977,7 ＠＠ { start = Qzero; } - else if (lisp_to_off_t (start) < 0) + else if (lisp_to_OFF_T (start) < 0) { start = wrong_type_argument (Qnatnump, start); } ＠＠ -3207,7 +3159,7 ＠＠ Lisp_Object args[] = { end, start }; Lisp_Object diff = Fminus (countof (args), args); - total = lisp_to_off_t (diff); + total = lisp_to_OFF_T (diff); if (total < 0) { ＠＠ -3231,7 +3183,7 ＠＠ where it should be. */ || (!NILP (replace) && do_speedy_insert)) { - if (lseek (fd, lisp_to_off_t (start), 0) < 0) + if (lseek (fd, lisp_to_OFF_T (start), 0) < 0) report_file_error ("Setting file position", filename); } ＠＠ -3567,7 +3519,7 ＠＠ if (NUMBERP (append)) { whence = SEEK_SET; - offset = lisp_to_off_t (append); + offset = lisp_to_OFF_T (append); if (offset < 0) { dead_wrong_type_argument (Qnatnump, append); diff -r 368318a5c386 -r 046a3f85a39d src/number.h --- a/src/number.h +++ b/src/number.h ＠＠ -437,6 +437,12 ＠＠ extern enum number_type get_number_type (Lisp_Object); extern enum number_type promote_args (Lisp_Object *, Lisp_Object *); +extern Lisp_Object OFF_T_to_lisp (OFF_T); +extern OFF_T lisp_to_OFF_T (Lisp_Object); + +extern Lisp_Object uid_t_to_lisp (uid_t); +extern uid_t lisp_to_uid_t (Lisp_Object); + #ifdef WITH_NUMBER_TYPES /* promote_args() *always* converts a marker argument to a fixnum. diff -r 368318a5c386 -r 046a3f85a39d tests/ChangeLog --- a/tests/ChangeLog +++ b/tests/ChangeLog ＠＠ -1,3 +1,9 ＠＠ +2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/os-tests.el (two-to-the-thirty-second): + Check that (user-login-name 4294967296) no longer gives "root", as + it used to do on 64-bit builds. + 2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/os-tests.el (handle-call-process-cases): New. diff -r 368318a5c386 -r 046a3f85a39d tests/automated/os-tests.el --- a/tests/automated/os-tests.el +++ b/tests/automated/os-tests.el ＠＠ -119,4 +119,14 ＠＠ '(22803 29256))) ;; "05/10/17 09:04:24 PM" (Check-Error args-out-of-range (encode-time 24 4 20 11 5 2017 86401)) +(let ((two-to-the-thirty-second (expt 2 32))) + (Skip-Test-Unless (and (integerp two-to-the-thirty-second) + (> two-to-the-thirty-second 0)) + "No integers greater than #x3fffffff" + "Testing bit width confusion with underlying uid_t" + (Assert + (not (equal (ignore-errors + (user-login-name two-to-the-thirty-second)) + "root"))))) + ;;; end of os-tests.el Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.