From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Paul Eggert Newsgroups: gmane.emacs.devel Subject: Re: Slightly extending commit 16b0520a9 Date: Sun, 6 Aug 2017 17:10:01 -0700 Organization: UCLA Computer Science Department Message-ID: References: <87o9rtuz2r.fsf@lylat> <87h8xluxlf.fsf@lylat> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------F3A4D01D06DBEDC1B72A3E10" X-Trace: blaine.gmane.org 1502064627 25591 195.159.176.226 (7 Aug 2017 00:10:27 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 7 Aug 2017 00:10:27 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.2.1 Cc: Alex , Emacs Development To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Aug 07 02:10:21 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1deVcf-00066p-QH for ged-emacs-devel@m.gmane.org; Mon, 07 Aug 2017 02:10:18 +0200 Original-Received: from localhost ([::1]:34719 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1deVcl-0001ZQ-Qs for ged-emacs-devel@m.gmane.org; Sun, 06 Aug 2017 20:10:23 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56446) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1deVcY-0001Xc-K2 for Emacs-devel@gnu.org; Sun, 06 Aug 2017 20:10:12 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1deVcV-00086o-Cf for Emacs-devel@gnu.org; Sun, 06 Aug 2017 20:10:10 -0400 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:33602) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1deVcV-00084t-1Q for Emacs-devel@gnu.org; Sun, 06 Aug 2017 20:10:07 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 843391607B0; Sun, 6 Aug 2017 17:10:04 -0700 (PDT) Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10032) with ESMTP id 3yaIEkTBIRk2; Sun, 6 Aug 2017 17:10:02 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 6F5EA1607B1; Sun, 6 Aug 2017 17:10:02 -0700 (PDT) X-Virus-Scanned: amavisd-new at zimbra.cs.ucla.edu Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id QJ3MVBAsUBaW; Sun, 6 Aug 2017 17:10:02 -0700 (PDT) Original-Received: from [192.168.1.9] (unknown [47.153.184.153]) by zimbra.cs.ucla.edu (Postfix) with ESMTPSA id 48F521607B0; Sun, 6 Aug 2017 17:10:02 -0700 (PDT) In-Reply-To: Content-Language: en-US X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-Received-From: 131.179.128.68 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:217345 Archived-At: This is a multi-part message in MIME format. --------------F3A4D01D06DBEDC1B72A3E10 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: quoted-printable Stefan Monnier wrote: > it seems that XCDR and XCAR here are > safe because before calling those functions, eval_sub happens to call > Flength on the args, and that triggers an error if the form is not > a proper list, so `XCDR (args)` will indeed be a cons once we get > to Fif. That's true only if the S-expression does not mutate as it is being evalu= ated.=20 If the S-expression modifies itself after Flength and before XCDR, Emacs = can=20 crash. So Alex's first patch is the opposite of what it should be: instea= d of=20 changing the Fcar to an XCAR, we should change an XCDR to an Fcdr in the = next=20 line. I looked for nearby instances of this problem, and fixed them by=20 installing the attached patch. This should address both problems that Ale= x=20 mentioned. > Arguably Fif could be called from elsewhere than eval_sub, and arguably > eval_sub's implementation could be changed in such a way that it doesn'= t > catch this error, so the safety of using XCDR is debatable. Even before the attached patch was installed, several UNEVALLED functions= =20 assumed that their arguments were proper lists. So, when writing the=20 abovementioned patch, I found it simpler to make this assumption everywhe= re. The=20 argument lists might become improper if they are mutated, so UNEVALLED fu= nctions=20 that can invoke arbitrary lisp code still must check the lists as they go= , though. > Fif should not be performance sensitive Yes, in this part of eval.c using XCDR instead of Fcdr is helpful mostly = as a=20 hint to the reader that the object is a cons; it's not a significant perf= ormance=20 improvement. --------------F3A4D01D06DBEDC1B72A3E10 Content-Type: text/x-patch; name="0001-Fix-some-crashes-on-self-modifying-Elisp-code.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="0001-Fix-some-crashes-on-self-modifying-Elisp-code.patch" =46rom d4278e1dbb023a230b8b0dbc212f0f3fa4391a72 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 6 Aug 2017 16:57:08 -0700 Subject: [PATCH] Fix some crashes on self-modifying Elisp code Prompted by a problem report by Alex in: http://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00143.html * src/eval.c (For, Fprogn, Fsetq, FletX, eval_sub): Compute XCDR (x) near XCAR (x); although this doesn't fix any bugs, it is likely to run a bit faster with typical hardware caches. (Fif): Use Fcdr instead of XCDR, to avoid crashing on self-modifying S-expressions. (Fsetq, Flet, eval_sub): Count the number of arguments as we go instead of trusting an Flength prepass, to avoid problems when the code is self-modifying. (Fquote, Ffunction, Fdefvar, Fdefconst): Prefer !NILP to CONSP where either will do. This is mostly to document the fact that the value must be a proper list. It's also a tiny bit faster on typical machines nowadays. (Fdefconst, FletX): Prefer XCAR+XCDR to Fcar+Fcdr when either will do. (eval_sub): Check that the args are a list as opposed to some other object that has a length. This prevents e.g. (if . "string") from making Emacs dump core in some cases. * test/src/eval-tests.el (eval-tests--if-dot-string) (eval-tests--let-with-circular-defs, eval-tests--mutating-cond): New tests. --- src/eval.c | 128 ++++++++++++++++++++++++++-----------------= ------ test/src/eval-tests.el | 20 ++++++++ 2 files changed, 87 insertions(+), 61 deletions(-) diff --git a/src/eval.c b/src/eval.c index e590038..fe2708b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -354,10 +354,11 @@ usage: (or CONDITIONS...) */) =20 while (CONSP (args)) { - val =3D eval_sub (XCAR (args)); + Lisp_Object arg =3D XCAR (args); + args =3D XCDR (args); + val =3D eval_sub (arg); if (!NILP (val)) break; - args =3D XCDR (args); } =20 return val; @@ -374,10 +375,11 @@ usage: (and CONDITIONS...) */) =20 while (CONSP (args)) { - val =3D eval_sub (XCAR (args)); + Lisp_Object arg =3D XCAR (args); + args =3D XCDR (args); + val =3D eval_sub (arg); if (NILP (val)) break; - args =3D XCDR (args); } =20 return val; @@ -397,7 +399,7 @@ usage: (if COND THEN ELSE...) */) =20 if (!NILP (cond)) return eval_sub (Fcar (XCDR (args))); - return Fprogn (XCDR (XCDR (args))); + return Fprogn (Fcdr (XCDR (args))); } =20 DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, @@ -439,8 +441,9 @@ usage: (progn BODY...) */) =20 while (CONSP (body)) { - val =3D eval_sub (XCAR (body)); + Lisp_Object form =3D XCAR (body); body =3D XCDR (body); + val =3D eval_sub (form); } =20 return val; @@ -488,35 +491,26 @@ The return value of the `setq' form is the value of= the last VAL. usage: (setq [SYM VAL]...) */) (Lisp_Object args) { - Lisp_Object val, sym, lex_binding; + Lisp_Object val =3D args, tail =3D args; =20 - val =3D args; - if (CONSP (args)) + for (EMACS_INT nargs =3D 0; CONSP (tail); nargs +=3D 2) { - Lisp_Object args_left =3D args; - Lisp_Object numargs =3D Flength (args); - - if (XINT (numargs) & 1) - xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs); - - do - { - val =3D eval_sub (Fcar (XCDR (args_left))); - sym =3D XCAR (args_left); - - /* Like for eval_sub, we do not check declared_special here since - it's been done when let-binding. */ - if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! = */ - && SYMBOLP (sym) - && !NILP (lex_binding - =3D Fassq (sym, Vinternal_interpreter_environment))) - XSETCDR (lex_binding, val); /* SYM is lexically bound. */ - else - Fset (sym, val); /* SYM is dynamically bound. */ - - args_left =3D Fcdr (XCDR (args_left)); - } - while (CONSP (args_left)); + Lisp_Object sym =3D XCAR (tail), lex_binding; + tail =3D XCDR (tail); + if (!CONSP (tail)) + xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1)); + Lisp_Object arg =3D XCAR (tail); + tail =3D XCDR (tail); + val =3D eval_sub (arg); + /* Like for eval_sub, we do not check declared_special here since + it's been done when let-binding. */ + if (!NILP (Vinternal_interpreter_environment) /* Mere optimization= ! */ + && SYMBOLP (sym) + && !NILP (lex_binding + =3D Fassq (sym, Vinternal_interpreter_environment))) + XSETCDR (lex_binding, val); /* SYM is lexically bound. */ + else + Fset (sym, val); /* SYM is dynamically bound. */ } =20 return val; @@ -535,7 +529,7 @@ of unexpected results when a quoted object is modifie= d. usage: (quote ARG) */) (Lisp_Object args) { - if (CONSP (XCDR (args))) + if (!NILP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args)); return XCAR (args); } @@ -549,7 +543,7 @@ usage: (function ARG) */) { Lisp_Object quoted =3D XCAR (args); =20 - if (CONSP (XCDR (args))) + if (!NILP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); =20 if (!NILP (Vinternal_interpreter_environment) @@ -734,9 +728,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) = */) sym =3D XCAR (args); tail =3D XCDR (args); =20 - if (CONSP (tail)) + if (!NILP (tail)) { - if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail)))) + if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail)))) error ("Too many arguments"); =20 tem =3D Fdefault_boundp (sym); @@ -803,20 +797,24 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)= Lisp_Object sym, tem; =20 sym =3D XCAR (args); - if (CONSP (Fcdr (XCDR (XCDR (args))))) - error ("Too many arguments"); + Lisp_Object docstring =3D Qnil; + if (!NILP (XCDR (XCDR (args)))) + { + if (!NILP (XCDR (XCDR (XCDR (args))))) + error ("Too many arguments"); + docstring =3D XCAR (XCDR (XCDR (args))); + } =20 - tem =3D eval_sub (Fcar (XCDR (args))); + tem =3D eval_sub (XCAR (XCDR (args))); if (!NILP (Vpurify_flag)) tem =3D Fpurecopy (tem); Fset_default (sym, tem); XSYMBOL (sym)->declared_special =3D 1; - tem =3D Fcar (XCDR (XCDR (args))); - if (!NILP (tem)) + if (!NILP (docstring)) { if (!NILP (Vpurify_flag)) - tem =3D Fpurecopy (tem); - Fput (sym, Qvariable_documentation, tem); + docstring =3D Fpurecopy (docstring); + Fput (sym, Qvariable_documentation, docstring); } Fput (sym, Qrisky_local_variable, Qt); LOADHIST_ATTACH (sym); @@ -844,27 +842,29 @@ Each VALUEFORM can refer to the symbols already bou= nd by this VARLIST. usage: (let* VARLIST BODY...) */) (Lisp_Object args) { - Lisp_Object varlist, var, val, elt, lexenv; + Lisp_Object var, val, elt, lexenv; ptrdiff_t count =3D SPECPDL_INDEX (); =20 lexenv =3D Vinternal_interpreter_environment; =20 - for (varlist =3D XCAR (args); CONSP (varlist); varlist =3D XCDR (varli= st)) + Lisp_Object varlist =3D XCAR (args); + while (CONSP (varlist)) { maybe_quit (); =20 elt =3D XCAR (varlist); + varlist =3D XCDR (varlist); if (SYMBOLP (elt)) { var =3D elt; val =3D Qnil; } - else if (! NILP (Fcdr (Fcdr (elt)))) - signal_error ("`let' bindings can have only one value-form", elt); else { var =3D Fcar (elt); - val =3D eval_sub (Fcar (Fcdr (elt))); + if (! NILP (Fcdr (XCDR (elt)))) + signal_error ("`let' bindings can have only one value-form", elt); + val =3D eval_sub (Fcar (XCDR (elt))); } =20 if (!NILP (lexenv) && SYMBOLP (var) @@ -911,33 +911,37 @@ usage: (let VARLIST BODY...) */) CHECK_LIST (varlist); =20 /* Make space to hold the values to give the bound variables. */ - elt =3D Flength (varlist); - SAFE_ALLOCA_LISP (temps, XFASTINT (elt)); + EMACS_INT varlist_len =3D XFASTINT (Flength (varlist)); + SAFE_ALLOCA_LISP (temps, varlist_len); + ptrdiff_t nvars =3D varlist_len; =20 /* Compute the values and store them in `temps'. */ =20 - for (argnum =3D 0; CONSP (varlist); varlist =3D XCDR (varlist)) + for (argnum =3D 0; argnum < nvars && CONSP (varlist); argnum++) { maybe_quit (); elt =3D XCAR (varlist); + varlist =3D XCDR (varlist); if (SYMBOLP (elt)) - temps [argnum++] =3D Qnil; + temps[argnum] =3D Qnil; else if (! NILP (Fcdr (Fcdr (elt)))) signal_error ("`let' bindings can have only one value-form", elt); else - temps [argnum++] =3D eval_sub (Fcar (Fcdr (elt))); + temps[argnum] =3D eval_sub (Fcar (Fcdr (elt))); } + nvars =3D argnum; =20 lexenv =3D Vinternal_interpreter_environment; =20 varlist =3D XCAR (args); - for (argnum =3D 0; CONSP (varlist); varlist =3D XCDR (varlist)) + for (argnum =3D 0; argnum < nvars && CONSP (varlist); argnum++) { Lisp_Object var; =20 elt =3D XCAR (varlist); + varlist =3D XCDR (varlist); var =3D SYMBOLP (elt) ? elt : Fcar (elt); - tem =3D temps[argnum++]; + tem =3D temps[argnum]; =20 if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special @@ -2135,6 +2139,7 @@ eval_sub (Lisp_Object form) =20 original_fun =3D XCAR (form); original_args =3D XCDR (form); + CHECK_LIST (original_args); =20 /* This also protects them from gc. */ count =3D record_in_backtrace (original_fun, &original_args, UNEVALLED= ); @@ -2176,15 +2181,16 @@ eval_sub (Lisp_Object form) =20 SAFE_ALLOCA_LISP (vals, XINT (numargs)); =20 - while (!NILP (args_left)) + while (CONSP (args_left) && argnum < XINT (numargs)) { - vals[argnum++] =3D eval_sub (Fcar (args_left)); - args_left =3D Fcdr (args_left); + Lisp_Object arg =3D XCAR (args_left); + args_left =3D XCDR (args_left); + vals[argnum++] =3D eval_sub (arg); } =20 - set_backtrace_args (specpdl + count, vals, XINT (numargs)); + set_backtrace_args (specpdl + count, vals, argnum); =20 - val =3D (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); + val =3D XSUBR (fun)->function.aMANY (argnum, vals); =20 check_cons_list (); lisp_eval_depth--; diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 03f4087..b98de0a 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -59,4 +59,24 @@ byte-compile-debug (should-error (,form ,arg) :type 'wrong-type-argument)) t))) =20 +(ert-deftest eval-tests--if-dot-string () + "Check that Emacs rejects (if . \"string\")." + (should-error (eval '(if . "abc")) :type 'wrong-type-argument) + (let ((if-tail (list '(setcdr if-tail "abc") t))) + (should-error (eval (cons 'if if-tail)))) + (let ((if-tail (list '(progn (setcdr if-tail "abc") nil) t))) + (should-error (eval (cons 'if if-tail))))) + +(ert-deftest eval-tests--let-with-circular-defs () + "Check that Emacs reports an error for (let VARS ...) when VARS is cir= cular." + (let ((vars (list 'v))) + (setcdr vars vars) + (dolist (let-sym '(let let*)) + (should-error (eval (list let-sym vars)))))) + +(ert-deftest eval-tests--mutating-cond () + "Check that Emacs doesn't crash on a cond clause that mutates during e= val." + (let ((clauses (list '((progn (setcdr clauses "ouch") nil))))) + (should-error (eval (cons 'cond clauses))))) + ;;; eval-tests.el ends here --=20 2.7.4 --------------F3A4D01D06DBEDC1B72A3E10--