Mercurial > emacs
comparison lisp/emacs-lisp/unsafep.el @ 47667:96b260e0ff3d
New major mode "SES" for spreadsheets.
New function (unsafep X) determines whether X is a safe Lisp form.
New support module testcover.el for coverage testing.
author | Jonathan Yavner <jyavner@member.fsf.org> |
---|---|
date | Sat, 28 Sep 2002 18:45:56 +0000 |
parents | |
children | 54e6db99ee89 |
comparison
equal
deleted
inserted
replaced
47666:537f1778caaf | 47667:96b260e0ff3d |
---|---|
1 ;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate | |
2 | |
3 ;; Copyright (C) Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Jonathan Yavner <jyavner@engineer.com> | |
6 ;; Maintainer: Jonathan Yavner <jyavner@engineer.com> | |
7 ;; Keywords: safety lisp utility | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; This is a simplistic implementation that does not allow any modification of | |
29 ;; buffers or global variables. It does no dataflow analysis, so functions | |
30 ;; like `funcall' and `setcar' are completely disallowed. It is designed | |
31 ;; for "pure Lisp" formulas, like those in spreadsheets, that don't make any | |
32 ;; use of the text editing capabilities of Emacs. | |
33 | |
34 ;; A formula is safe if: | |
35 ;; 1. It's an atom. | |
36 ;; 2. It's a function call to a safe function and all arguments are safe | |
37 ;; formulas. | |
38 ;; 3. It's a special form whose arguments are like a function's (and, | |
39 ;; catch, if, or, prog1, prog2, progn, while, unwind-protect). | |
40 ;; 4. It's a special form or macro that creates safe temporary bindings | |
41 ;; (condition-case, dolist, dotimes, lambda, let, let*). | |
42 ;; 4. It's one of (cond, quote) that have special parsing. | |
43 ;; 5. It's one of (add-to-list, setq, push, pop) and the assignment variable | |
44 ;; is safe. | |
45 ;; 6. It's one of (apply, mapc, mapcar, mapconcat) and its first arg is a | |
46 ;; quoted safe function. | |
47 ;; | |
48 ;; A function is safe if: | |
49 ;; 1. It's a lambda containing safe formulas. | |
50 ;; 2. It's a member of list `safe-functions', so the user says it's safe. | |
51 ;; 3. It's a symbol with the `side-effect-free' property, defined by the | |
52 ;; byte compiler or function author. | |
53 ;; 4. It's a symbol with the `safe-function' property, defined here or by | |
54 ;; the function author. Value t indicates a function that is safe but | |
55 ;; has innocuous side effects. Other values will someday indicate | |
56 ;; functions with side effects that are not always safe. | |
57 ;; The `side-effect-free' and `safe-function' properties are provided for | |
58 ;; built-in functions and for functions and macros defined in subr.el. | |
59 ;; | |
60 ;; A temporary binding is unsafe if its symbol: | |
61 ;; 1. Has the `risky-local-variable' property. | |
62 ;; 2. Has a name that ends with -command, font-lock-keywords(-[0-9]+)?, | |
63 ;; font-lock-syntactic-keywords, -form, -forms, -frame-alist, -function, | |
64 ;; -functions, -history, -hook, -hooks, -map, -map-alist, -mode-alist, | |
65 ;; -predicate, or -program. | |
66 ;; | |
67 ;; An assignment variable is unsafe if: | |
68 ;; 1. It would be unsafe as a temporary binding. | |
69 ;; 2. It doesn't already have a temporary or buffer-local binding. | |
70 | |
71 ;; There are unsafe forms that `unsafep' cannot detect. Beware of these: | |
72 ;; 1. The form's result is a string with a display property containing a | |
73 ;; form to be evaluated later, and you insert this result into a | |
74 ;; buffer. Always remove display properties before inserting! | |
75 ;; 2. The form alters a risky variable that was recently added to Emacs and | |
76 ;; is not yet marked with the `risky-local-variable' property. | |
77 ;; 3. The form uses undocumented features of built-in functions that have | |
78 ;; the `side-effect-free' property. For example, in Emacs-20 if you | |
79 ;; passed a circular list to `assoc', Emacs would crash. Historically, | |
80 ;; problems of this kind have been few and short-lived. | |
81 | |
82 (provide 'unsafep) | |
83 (require 'byte-opt) ;Set up the `side-effect-free' properties | |
84 | |
85 (defcustom safe-functions nil | |
86 "t to disable all safety checks, or a list of assumed-safe functions." | |
87 :group 'lisp | |
88 :type '(choice (const :tag "No" nil) (const :tag "Yes" t) hook)) | |
89 | |
90 (defvar unsafep-vars nil | |
91 "Dynamically-bound list of variables that have lexical bindings at this | |
92 point in the parse.") | |
93 (put 'unsafep-vars 'risky-local-variable t) | |
94 | |
95 ;;Side-effect-free functions from subr.el | |
96 (dolist (x '(assoc-default assoc-ignore-case butlast last match-string | |
97 match-string-no-properties member-ignore-case remove remq)) | |
98 (put x 'side-effect-free t)) | |
99 | |
100 ;;Other safe functions | |
101 (dolist (x '(;;Special forms | |
102 and catch if or prog1 prog2 progn while unwind-protect | |
103 ;;Safe subrs that have some side-effects | |
104 ding error message minibuffer-message random read-minibuffer | |
105 signal sleep-for string-match throw y-or-n-p yes-or-no-p | |
106 ;;Defsubst functions from subr.el | |
107 caar cadr cdar cddr | |
108 ;;Macros from subr.el | |
109 save-match-data unless when with-temp-message | |
110 ;;Functions from subr.el that have side effects | |
111 read-passwd split-string replace-regexp-in-string | |
112 play-sound-file)) | |
113 (put x 'safe-function t)) | |
114 | |
115 ;;;###autoload | |
116 (defun unsafep (form &optional unsafep-vars) | |
117 "Return nil if evaluating FORM couldn't possibly do any harm; otherwise | |
118 result is a reason why FORM is unsafe. UNSAFEP-VARS is a list of symbols | |
119 with local bindings." | |
120 (catch 'unsafep | |
121 (if (or (eq safe-functions t) ;User turned off safety-checking | |
122 (atom form)) ;Atoms are never unsafe | |
123 (throw 'unsafep nil)) | |
124 (let* ((fun (car form)) | |
125 (reason (unsafep-function fun)) | |
126 arg) | |
127 (cond | |
128 ((not reason) | |
129 ;;It's a normal function - unsafe if any arg is | |
130 (unsafep-progn (cdr form))) | |
131 ((eq fun 'quote) | |
132 ;;Never unsafe | |
133 nil) | |
134 ((memq fun '(apply mapc mapcar mapconcat)) | |
135 ;;Unsafe if 1st arg isn't a quoted lambda | |
136 (setq arg (cadr form)) | |
137 (cond | |
138 ((memq (car-safe arg) '(quote function)) | |
139 (setq reason (unsafep-function (cadr arg)))) | |
140 ((eq (car-safe arg) 'lambda) | |
141 ;;Self-quoting lambda | |
142 (setq reason (unsafep arg unsafep-vars))) | |
143 (t | |
144 (setq reason `(unquoted ,arg)))) | |
145 (or reason (unsafep-progn (cddr form)))) | |
146 ((eq fun 'lambda) | |
147 ;;First arg is temporary bindings | |
148 (mapc #'(lambda (x) | |
149 (let ((y (unsafep-variable x t))) | |
150 (if y (throw 'unsafep y))) | |
151 (or (memq x '(&optional &rest)) | |
152 (push x unsafep-vars))) | |
153 (cadr form)) | |
154 (unsafep-progn (cddr form))) | |
155 ((eq fun 'let) | |
156 ;;Creates temporary bindings in one step | |
157 (setq unsafep-vars (nconc (mapcar #'unsafep-let (cadr form)) | |
158 unsafep-vars)) | |
159 (unsafep-progn (cddr form))) | |
160 ((eq fun 'let*) | |
161 ;;Creates temporary bindings iteratively | |
162 (dolist (x (cadr form)) | |
163 (push (unsafep-let x) unsafep-vars)) | |
164 (unsafep-progn (cddr form))) | |
165 ((eq fun 'setq) | |
166 ;;Safe if odd arguments are local-var syms, evens are safe exprs | |
167 (setq arg (cdr form)) | |
168 (while arg | |
169 (setq reason (or (unsafep-variable (car arg) nil) | |
170 (unsafep (cadr arg) unsafep-vars))) | |
171 (if reason (throw 'unsafep reason)) | |
172 (setq arg (cddr arg)))) | |
173 ((eq fun 'pop) | |
174 ;;safe if arg is local-var sym | |
175 (unsafep-variable (cadr form) nil)) | |
176 ((eq fun 'push) | |
177 ;;Safe if 2nd arg is a local-var sym | |
178 (or (unsafep (cadr form) unsafep-vars) | |
179 (unsafep-variable (nth 2 form) nil))) | |
180 ((eq fun 'add-to-list) | |
181 ;;Safe if first arg is a quoted local-var sym | |
182 (setq arg (cadr form)) | |
183 (if (not (eq (car-safe arg) 'quote)) | |
184 `(unquoted ,arg) | |
185 (or (unsafep-variable (cadr arg) nil) | |
186 (unsafep-progn (cddr form))))) | |
187 ((eq fun 'cond) | |
188 ;;Special form with unusual syntax - safe if all args are | |
189 (dolist (x (cdr form)) | |
190 (setq reason (unsafep-progn x)) | |
191 (if reason (throw 'unsafep reason)))) | |
192 ((memq fun '(dolist dotimes)) | |
193 ;;Safe if COUNT and RESULT are safe. VAR is bound while checking BODY. | |
194 (setq arg (cadr form)) | |
195 (or (unsafep-progn (cdr arg)) | |
196 (let ((unsafep-vars (cons (car arg) unsafep-vars))) | |
197 (unsafep-progn (cddr form))))) | |
198 ((eq fun 'condition-case) | |
199 ;;Special form with unusual syntax - safe if all args are | |
200 (or (unsafep-variable (cadr form) t) | |
201 (unsafep (nth 2 form) unsafep-vars) | |
202 (let ((unsafep-vars (cons (cadr form) unsafep-vars))) | |
203 ;;var is bound only during handlers | |
204 (dolist (x (nthcdr 3 form)) | |
205 (setq reason (unsafep-progn (cdr x))) | |
206 (if reason (throw 'unsafep reason)))))) | |
207 (t | |
208 ;;First unsafep-function call above wasn't nil, no special case applies | |
209 reason))))) | |
210 | |
211 | |
212 (defun unsafep-function (fun) | |
213 "Return nil if FUN is a safe function (either a safe lambda or a | |
214 symbol that names a safe function). Otherwise result is a reason code." | |
215 (cond | |
216 ((eq (car-safe fun) 'lambda) | |
217 (unsafep fun unsafep-vars)) | |
218 ((not (and (symbolp fun) | |
219 (or (get fun 'side-effect-free) | |
220 (eq (get fun 'safe-function) t) | |
221 (eq safe-functions t) | |
222 (memq fun safe-functions)))) | |
223 `(function ,fun)))) | |
224 | |
225 (defun unsafep-progn (list) | |
226 "Return nil if all forms in LIST are safe, or the reason for the first | |
227 unsafe form." | |
228 (catch 'unsafep-progn | |
229 (let (reason) | |
230 (dolist (x list) | |
231 (setq reason (unsafep x unsafep-vars)) | |
232 (if reason (throw 'unsafep-progn reason)))))) | |
233 | |
234 (defun unsafep-let (clause) | |
235 "CLAUSE is a let-binding, either SYM or (SYM) or (SYM VAL). Throws a | |
236 reason to `unsafep' if VAL isn't safe. Returns SYM." | |
237 (let (reason sym) | |
238 (if (atom clause) | |
239 (setq sym clause) | |
240 (setq sym (car clause) | |
241 reason (unsafep (cadr clause) unsafep-vars))) | |
242 (setq reason (or (unsafep-variable sym t) reason)) | |
243 (if reason (throw 'unsafep reason)) | |
244 sym)) | |
245 | |
246 (defun unsafep-variable (sym global-okay) | |
247 "Returns nil if SYM is lexically bound or is a non-risky buffer-local | |
248 variable, otherwise a reason why it is unsafe. Failing to be locally bound | |
249 is okay if GLOBAL-OKAY is non-nil." | |
250 (cond | |
251 ((not (symbolp sym)) | |
252 `(variable ,sym)) | |
253 ((risky-local-variable-p sym) | |
254 `(risky-local-variable ,sym)) | |
255 ((not (or global-okay | |
256 (memq sym unsafep-vars) | |
257 (local-variable-p sym))) | |
258 `(global-variable ,sym)))) | |
259 | |
260 ;; unsafep.el ends here. |