* lisp/emacs-lisp/lisp.el (lisp-completion-at-point): Don't use
[emacs.git] / lisp / emacs-lisp / unsafep.el
1 ;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
2
3 ;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
4
5 ;; Author: Jonathan Yavner <jyavner@member.fsf.org>
6 ;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
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 3 of the License, or
14 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;; This is a simplistic implementation that does not allow any modification of
27 ;; buffers or global variables.  It does no dataflow analysis, so functions
28 ;; like `funcall' and `setcar' are completely disallowed.  It is designed
29 ;; for "pure Lisp" formulas, like those in spreadsheets, that don't make any
30 ;; use of the text editing capabilities of Emacs.
31
32 ;; A formula is safe if:
33 ;;  1.  It's an atom.
34 ;;  2.  It's a function call to a safe function and all arguments are safe
35 ;;      formulas.
36 ;;  3.  It's a special form whose arguments are like a function's (and,
37 ;;      catch, if, or, prog1, prog2, progn, while, unwind-protect).
38 ;;  4.  It's a special form or macro that creates safe temporary bindings
39 ;;      (condition-case, dolist, dotimes, lambda, let, let*).
40 ;;  4.  It's one of (cond, quote) that have special parsing.
41 ;;  5.  It's one of (add-to-list, setq, push, pop) and the assignment variable
42 ;;      is safe.
43 ;;  6.  It's one of (apply, mapc, mapcar, mapconcat) and its first arg is a
44 ;;      quoted safe function.
45 ;;
46 ;; A function is safe if:
47 ;;  1.  It's a lambda containing safe formulas.
48 ;;  2.  It's a member of list `safe-functions', so the user says it's safe.
49 ;;  3.  It's a symbol with the `side-effect-free' property, defined by the
50 ;;      byte compiler or function author.
51 ;;  4.  It's a symbol with the `safe-function' property, defined here or by
52 ;;      the function author.  Value t indicates a function that is safe but
53 ;;      has innocuous side effects.  Other values will someday indicate
54 ;;      functions with side effects that are not always safe.
55 ;;  The `side-effect-free' and `safe-function' properties are provided for
56 ;;  built-in functions and for functions and macros defined in subr.el.
57 ;;
58 ;; A temporary binding is unsafe if its symbol:
59 ;;  1.  Has the `risky-local-variable' property.
60 ;;  2.  Has a name that ends with -command, font-lock-keywords(-[0-9]+)?,
61 ;;      font-lock-syntactic-keywords, -form, -forms, -frame-alist, -function,
62 ;;       -functions, -history, -hook, -hooks, -map, -map-alist, -mode-alist,
63 ;;       -predicate, or -program.
64 ;;
65 ;; An assignment variable is unsafe if:
66 ;;   1. It would be unsafe as a temporary binding.
67 ;;   2. It doesn't already have a temporary or buffer-local binding.
68
69 ;; There are unsafe forms that `unsafep' cannot detect.  Beware of these:
70 ;;   1. The form's result is a string with a display property containing a
71 ;;      form to be evaluated later, and you insert this result into a
72 ;;      buffer.  Always remove display properties before inserting!
73 ;;   2. The form alters a risky variable that was recently added to Emacs and
74 ;;      is not yet marked with the `risky-local-variable' property.
75 ;;   3. The form uses undocumented features of built-in functions that have
76 ;;      the `side-effect-free' property.  For example, in Emacs-20 if you
77 ;;      passed a circular list to `assoc', Emacs would crash.  Historically,
78 ;;      problems of this kind have been few and short-lived.
79
80 ;;; Code:
81
82 (provide 'unsafep)
83 (require 'byte-opt)  ;Set up the `side-effect-free' properties
84
85 (defcustom safe-functions nil
86   "A list of assumed-safe functions, or t to disable `unsafep'."
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 with lexical bindings at this point
92 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 random signal sleep-for string-match throw
105              ;;Defsubst functions from subr.el
106              caar cadr cdar cddr
107              ;;Macros from subr.el
108              save-match-data unless when
109              ;;Functions from subr.el that have side effects
110              split-string replace-regexp-in-string play-sound-file))
111   (put x 'safe-function t))
112
113 ;;;###autoload
114 (defun unsafep (form &optional unsafep-vars)
115   "Return nil if evaluating FORM couldn't possibly do any harm.
116 Otherwise result is a reason why FORM is unsafe.
117 UNSAFEP-VARS is a list of symbols with local bindings."
118   (catch 'unsafep
119     (if (or (eq safe-functions t)           ;User turned off safety-checking
120             (atom form))                    ;Atoms are never unsafe
121         (throw 'unsafep nil))
122     (let* ((fun    (car form))
123            (reason (unsafep-function fun))
124            arg)
125       (cond
126        ((not reason)
127         ;;It's a normal function - unsafe if any arg is
128         (unsafep-progn (cdr form)))
129        ((eq fun 'quote)
130         ;;Never unsafe
131         nil)
132        ((memq fun '(apply mapc mapcar mapconcat))
133         ;;Unsafe if 1st arg isn't a quoted lambda
134         (setq arg (cadr form))
135         (cond
136          ((memq (car-safe arg) '(quote function))
137           (setq reason (unsafep-function (cadr arg))))
138          ((eq (car-safe arg) 'lambda)
139           ;;Self-quoting lambda
140           (setq reason (unsafep arg unsafep-vars)))
141          (t
142           (setq reason `(unquoted ,arg))))
143         (or reason (unsafep-progn (cddr form))))
144        ((eq fun 'lambda)
145         ;;First arg is temporary bindings
146         (mapc #'(lambda (x)
147                   (or (memq x '(&optional &rest))
148                       (let ((y (unsafep-variable x t)))
149                         (if y (throw 'unsafep y))
150                         (push x unsafep-vars))))
151               (cadr form))
152         (unsafep-progn (cddr form)))
153        ((eq fun 'let)
154         ;;Creates temporary bindings in one step
155         (setq unsafep-vars (nconc (mapcar #'unsafep-let (cadr form))
156                                   unsafep-vars))
157         (unsafep-progn (cddr form)))
158        ((eq fun 'let*)
159         ;;Creates temporary bindings iteratively
160         (dolist (x (cadr form))
161           (push (unsafep-let x) unsafep-vars))
162         (unsafep-progn (cddr form)))
163        ((eq fun 'setq)
164         ;;Safe if odd arguments are local-var syms, evens are safe exprs
165         (setq arg (cdr form))
166         (while arg
167           (setq reason (or (unsafep-variable (car arg) nil)
168                            (unsafep (cadr arg) unsafep-vars)))
169           (if reason (throw 'unsafep reason))
170           (setq arg (cddr arg))))
171        ((eq fun 'pop)
172         ;;safe if arg is local-var sym
173         (unsafep-variable (cadr form) nil))
174        ((eq fun 'push)
175         ;;Safe if 2nd arg is a local-var sym
176         (or (unsafep (cadr form) unsafep-vars)
177             (unsafep-variable (nth 2 form) nil)))
178        ((eq fun 'add-to-list)
179         ;;Safe if first arg is a quoted local-var sym
180         (setq arg (cadr form))
181         (if (not (eq (car-safe arg) 'quote))
182             `(unquoted ,arg)
183           (or (unsafep-variable (cadr arg) nil)
184               (unsafep-progn (cddr form)))))
185        ((eq fun 'cond)
186         ;;Special form with unusual syntax - safe if all args are
187         (dolist (x (cdr form))
188           (setq reason (unsafep-progn x))
189           (if reason (throw 'unsafep reason))))
190        ((memq fun '(dolist dotimes))
191         ;;Safe if COUNT and RESULT are safe.  VAR is bound while checking BODY.
192         (setq arg (cadr form))
193         (or (unsafep-progn (cdr arg))
194             (let ((unsafep-vars (cons (car arg) unsafep-vars)))
195               (unsafep-progn (cddr form)))))
196        ((eq fun 'condition-case)
197         ;;Special form with unusual syntax - safe if all args are
198         (or (unsafep-variable (cadr form) t)
199             (unsafep (nth 2 form) unsafep-vars)
200             (let ((unsafep-vars (cons (cadr form) unsafep-vars)))
201               ;;var is bound only during handlers
202               (dolist (x (nthcdr 3 form))
203                 (setq reason (unsafep-progn (cdr x)))
204                 (if reason (throw 'unsafep reason))))))
205        ((eq fun '\`)
206         ;; Backquoted form - safe if its expansion is.
207         (unsafep (cdr (backquote-process (cadr form)))))
208        (t
209         ;;First unsafep-function call above wasn't nil, no special case applies
210         reason)))))
211
212
213 (defun unsafep-function (fun)
214   "Return nil if FUN is a safe function.
215 \(Either a safe lambda or a symbol that names a safe function).
216 Otherwise result is a reason code."
217   (cond
218    ((eq (car-safe fun) 'lambda)
219     (unsafep fun unsafep-vars))
220    ((not (and (symbolp fun)
221               (or (get fun 'side-effect-free)
222                   (eq (get fun 'safe-function) t)
223                   (eq safe-functions t)
224                   (memq fun safe-functions))))
225     `(function ,fun))))
226
227 (defun unsafep-progn (list)
228   "Return nil if all forms in LIST are safe.
229 Else, return the reason for the first unsafe form."
230   (catch 'unsafep-progn
231     (let (reason)
232       (dolist (x list)
233         (setq reason (unsafep x unsafep-vars))
234         (if reason (throw 'unsafep-progn reason))))))
235
236 (defun unsafep-let (clause)
237   "Check the safety of a let binding.
238 CLAUSE is a let-binding, either SYM or (SYM) or (SYM VAL).
239 Check VAL and throw a reason to `unsafep' if unsafe.
240 Return SYM."
241   (let (reason sym)
242     (if (atom clause)
243         (setq sym clause)
244       (setq sym    (car clause)
245             reason (unsafep (cadr clause) unsafep-vars)))
246     (setq reason (or (unsafep-variable sym t) reason))
247     (if reason (throw 'unsafep reason))
248     sym))
249
250 (defun unsafep-variable (sym to-bind)
251   "Return nil if SYM is safe to set or bind, or a reason why not.
252 If TO-BIND is nil, check whether SYM is safe to set.
253 If TO-BIND is t, check whether SYM is safe to bind."
254   (cond
255    ((not (symbolp sym))
256     `(variable ,sym))
257    ((risky-local-variable-p sym nil)
258     `(risky-local-variable ,sym))
259    ((not (or to-bind
260              (memq sym unsafep-vars)
261              (local-variable-p sym)))
262     `(global-variable ,sym))))
263
264 ;;; unsafep.el ends here