1;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate 2 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 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 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., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, 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;;; Code: 83 84(provide 'unsafep) 85(require 'byte-opt) ;Set up the `side-effect-free' properties 86 87(defcustom safe-functions nil 88 "A list of assumed-safe functions, or t to disable `unsafep'." 89 :group 'lisp 90 :type '(choice (const :tag "No" nil) (const :tag "Yes" t) hook)) 91 92(defvar unsafep-vars nil 93 "Dynamically-bound list of variables with lexical bindings at this point 94in the parse.") 95(put 'unsafep-vars 'risky-local-variable t) 96 97;;Side-effect-free functions from subr.el 98(dolist (x '(assoc-default assoc-ignore-case butlast last match-string 99 match-string-no-properties member-ignore-case remove remq)) 100 (put x 'side-effect-free t)) 101 102;;Other safe functions 103(dolist (x '(;;Special forms 104 and catch if or prog1 prog2 progn while unwind-protect 105 ;;Safe subrs that have some side-effects 106 ding error message minibuffer-message random read-minibuffer 107 signal sleep-for string-match throw y-or-n-p yes-or-no-p 108 ;;Defsubst functions from subr.el 109 caar cadr cdar cddr 110 ;;Macros from subr.el 111 save-match-data unless when with-temp-message 112 ;;Functions from subr.el that have side effects 113 read-passwd split-string replace-regexp-in-string 114 play-sound-file)) 115 (put x 'safe-function t)) 116 117;;;###autoload 118(defun unsafep (form &optional unsafep-vars) 119 "Return nil if evaluating FORM couldn't possibly do any harm; 120otherwise result is a reason why FORM is unsafe. UNSAFEP-VARS is a list 121of symbols with local bindings." 122 (catch 'unsafep 123 (if (or (eq safe-functions t) ;User turned off safety-checking 124 (atom form)) ;Atoms are never unsafe 125 (throw 'unsafep nil)) 126 (let* ((fun (car form)) 127 (reason (unsafep-function fun)) 128 arg) 129 (cond 130 ((not reason) 131 ;;It's a normal function - unsafe if any arg is 132 (unsafep-progn (cdr form))) 133 ((eq fun 'quote) 134 ;;Never unsafe 135 nil) 136 ((memq fun '(apply mapc mapcar mapconcat)) 137 ;;Unsafe if 1st arg isn't a quoted lambda 138 (setq arg (cadr form)) 139 (cond 140 ((memq (car-safe arg) '(quote function)) 141 (setq reason (unsafep-function (cadr arg)))) 142 ((eq (car-safe arg) 'lambda) 143 ;;Self-quoting lambda 144 (setq reason (unsafep arg unsafep-vars))) 145 (t 146 (setq reason `(unquoted ,arg)))) 147 (or reason (unsafep-progn (cddr form)))) 148 ((eq fun 'lambda) 149 ;;First arg is temporary bindings 150 (mapc #'(lambda (x) 151 (or (memq x '(&optional &rest)) 152 (let ((y (unsafep-variable x t))) 153 (if y (throw 'unsafep y)) 154 (push x unsafep-vars)))) 155 (cadr form)) 156 (unsafep-progn (cddr form))) 157 ((eq fun 'let) 158 ;;Creates temporary bindings in one step 159 (setq unsafep-vars (nconc (mapcar #'unsafep-let (cadr form)) 160 unsafep-vars)) 161 (unsafep-progn (cddr form))) 162 ((eq fun 'let*) 163 ;;Creates temporary bindings iteratively 164 (dolist (x (cadr form)) 165 (push (unsafep-let x) unsafep-vars)) 166 (unsafep-progn (cddr form))) 167 ((eq fun 'setq) 168 ;;Safe if odd arguments are local-var syms, evens are safe exprs 169 (setq arg (cdr form)) 170 (while arg 171 (setq reason (or (unsafep-variable (car arg) nil) 172 (unsafep (cadr arg) unsafep-vars))) 173 (if reason (throw 'unsafep reason)) 174 (setq arg (cddr arg)))) 175 ((eq fun 'pop) 176 ;;safe if arg is local-var sym 177 (unsafep-variable (cadr form) nil)) 178 ((eq fun 'push) 179 ;;Safe if 2nd arg is a local-var sym 180 (or (unsafep (cadr form) unsafep-vars) 181 (unsafep-variable (nth 2 form) nil))) 182 ((eq fun 'add-to-list) 183 ;;Safe if first arg is a quoted local-var sym 184 (setq arg (cadr form)) 185 (if (not (eq (car-safe arg) 'quote)) 186 `(unquoted ,arg) 187 (or (unsafep-variable (cadr arg) nil) 188 (unsafep-progn (cddr form))))) 189 ((eq fun 'cond) 190 ;;Special form with unusual syntax - safe if all args are 191 (dolist (x (cdr form)) 192 (setq reason (unsafep-progn x)) 193 (if reason (throw 'unsafep reason)))) 194 ((memq fun '(dolist dotimes)) 195 ;;Safe if COUNT and RESULT are safe. VAR is bound while checking BODY. 196 (setq arg (cadr form)) 197 (or (unsafep-progn (cdr arg)) 198 (let ((unsafep-vars (cons (car arg) unsafep-vars))) 199 (unsafep-progn (cddr form))))) 200 ((eq fun 'condition-case) 201 ;;Special form with unusual syntax - safe if all args are 202 (or (unsafep-variable (cadr form) t) 203 (unsafep (nth 2 form) unsafep-vars) 204 (let ((unsafep-vars (cons (cadr form) unsafep-vars))) 205 ;;var is bound only during handlers 206 (dolist (x (nthcdr 3 form)) 207 (setq reason (unsafep-progn (cdr x))) 208 (if reason (throw 'unsafep reason)))))) 209 (t 210 ;;First unsafep-function call above wasn't nil, no special case applies 211 reason))))) 212 213 214(defun unsafep-function (fun) 215 "Return nil iff FUN is a safe function. 216\(either a safe lambda or a symbol that names a safe function). Otherwise 217result is a reason code." 218 (cond 219 ((eq (car-safe fun) 'lambda) 220 (unsafep fun unsafep-vars)) 221 ((not (and (symbolp fun) 222 (or (get fun 'side-effect-free) 223 (eq (get fun 'safe-function) t) 224 (eq safe-functions t) 225 (memq fun safe-functions)))) 226 `(function ,fun)))) 227 228(defun unsafep-progn (list) 229 "Return nil if all forms in LIST are safe, or the reason 230for the first unsafe form." 231 (catch 'unsafep-progn 232 (let (reason) 233 (dolist (x list) 234 (setq reason (unsafep x unsafep-vars)) 235 (if reason (throw 'unsafep-progn reason)))))) 236 237(defun unsafep-let (clause) 238 "Check the safety of a let binding. 239CLAUSE is a let-binding, either SYM or (SYM) or (SYM VAL). Checks VAL 240and throws a reason to `unsafep' if unsafe. Returns 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. 252If TO-BIND is nil, check whether SYM is safe to set. 253If 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;; arch-tag: 6216f98b-eb8f-467a-9c33-7a7644f50658 265;;; unsafep.el ends here 266