[COMMIT] Warn if CONTROL-STRING is not constant, #'format, #'message.

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1552506428 0 # Wed Mar 13 19:47:08 2019 +0000 # Node ID 680638011e1445530ab21276b6ded53554768dd0 # Parent 9061f6baa93095d8fbd6b487a4ef8f12acc620c4 Warn if CONTROL-STRING is not constant, #'format, #'message. 2011-03-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; * bytecomp.el: * bytecomp.el (byte-compile-default-warnings): * bytecomp.el (byte-compiler-legal-options): * bytecomp.el (byte-compile-format): New. * bytecomp.el (byte-compile-message): New. Introduce `byte-compile-format', which warns if CONTROL-STRING is not constant, something that is reasonably often a security issue. Suppress this warning for calls to #'gettext, or if-statements both branches of which are constant strings. diff -r 9061f6baa930 -r 680638011e14 lisp/ChangeLog --- a/lisp/ChangeLog Sun Mar 10 18:02:36 2019 +0000 +++ b/lisp/ChangeLog Wed Mar 13 19:47:08 2019 +0000 ＠＠ -1,3 +1,15 ＠＠ +2011-03-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * bytecomp.el: + * bytecomp.el (byte-compile-default-warnings): + * bytecomp.el (byte-compiler-legal-options): + * bytecomp.el (byte-compile-format): New. + * bytecomp.el (byte-compile-message): New. + Introduce `byte-compile-format', which warns if CONTROL-STRING is + not constant, something that is reasonably often a security + issue. Suppress this warning for calls to #'gettext, or + if-statements both branches of which are constant strings. + 2018-10-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; * font-lock.el (font-lock-fontify-syntactically-region): diff -r 9061f6baa930 -r 680638011e14 lisp/bytecomp.el --- a/lisp/bytecomp.el Sun Mar 10 18:02:36 2019 +0000 +++ b/lisp/bytecomp.el Wed Mar 13 19:47:08 2019 +0000 ＠＠ -121,6 +121,8 ＠＠ ;;; as data, not as a function, ;;; and using it in a function ;;; context ) +;;; 'format-not-constant (using #'format without +;;; a constant CONTROL-STRING) ;;; emacs-lisp-file-regexp Regexp for the extension of source-files; ;;; see also the function `byte-compile-dest-file'. ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. ＠＠ -342,7 +344,7 ＠＠ ;; byte-compile-warning-types in FSF. (defvar byte-compile-default-warnings '(redefine callargs subr-callargs free-vars unresolved unused-vars obsolete - discarded-consing quoted-lambda) + discarded-consing quoted-lambda format-not-constant) "*The warnings used when byte-compile-warnings is t.") (defvar byte-compile-warnings t ＠＠ -1419,7 +1421,8 ＠＠ (new-bytecodes byte-compile-new-bytecodes (t nil) val) (warnings byte-compile-warnings ((callargs subr-callargs redefine free-vars unused-vars - unresolved discarded-consing quoted-lambda)) + unresolved discarded-consing quoted-lambda + format-not-constant)) val))) ;; XEmacs addition ＠＠ -4186,6 +4189,8 ＠＠ (byte-defop-compiler-1 let*) (byte-defop-compiler-1 integerp) +(byte-defop-compiler-1 format) +(byte-defop-compiler-1 message) (byte-defop-compiler-1 eql) (byte-defop-compiler-1 fillarray) (byte-defop-compiler-1 gensym) ＠＠ -4490,6 +4495,25 ＠＠ (prin1-to-string (nth 1 form))))) (byte-compile-normal-call form)) +(defun byte-compile-format (form) + (labels ((sufficiently-constant-stringp (form) + (or (stringp form) + (and (eq 'if (car-safe form)) + (every #'sufficiently-constant-stringp (cddr form))) + (and (or (eq 'gettext (car-safe form)) + (eq 'substitute-command-keys (car-safe form))) + (every #'sufficiently-constant-stringp (cdr form)))))) + (when (and (memq 'format-not-constant byte-compile-warnings) + (not (sufficiently-constant-stringp (second form)))) + (byte-compile-warn "#'%s called with a non-constant CONTROL-STRING, %S" + (first form) (second form))) + (byte-compile-normal-call form))) + +(defun byte-compile-message (form) + (if (and (null (second form)) (eql 2 (length form))) + (byte-compile-normal-call form) + (byte-compile-format form))) + ;;(byte-defop-compiler-1 /= byte-compile-negated) (byte-defop-compiler-1 atom byte-compile-negated) (byte-defop-compiler-1 nlistp byte-compile-negated) -- ‘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)