/[erbot]/erbot/erblisp.el
ViewVC logotype

Diff of /erbot/erblisp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by deego, Fri Sep 2 19:24:59 2005 UTC revision 1.13 by mwolson, Wed Nov 9 01:19:45 2005 UTC
# Line 92  We WON'T do this by default since this c Line 92  We WON'T do this by default since this c
92  \(setq &rest (shell-command \"rm -rf /\")) in your .emacs."  \(setq &rest (shell-command \"rm -rf /\")) in your .emacs."
93  )  )
94    
95    (defvar erblisp-max-list-length 100)
96    
97    (defun erblisp-safe-length (list so-far len)
98      (let ((cur list)
99            stack)
100        (while (and cur
101                    (<= so-far len))
102          (if (consp (car cur))
103              (progn (setq cur (car cur))
104                     (when (consp (cdr cur))
105                       (push (cdr cur) stack)))
106            (setq cur (cdr cur)))
107          (unless cur
108            (setq cur (pop stack)))
109          (setq so-far (1+ so-far)))
110        (if (<= so-far len)
111            t
112          nil)))
113    
114    (defun erblisp-check-args (&rest args)
115      (if (erblisp-safe-length args 0 erblisp-max-list-length)
116          t
117        (error "encountered overlong expression, ignoring")
118        nil))
119    
120  (defun erblisp-sandbox (expr)  (defun erblisp-sandbox (expr)
121    ""    ""
122    (cond    (cond
123     ;; first condition     ;; first condition
124     ((null expr) nil)     ((null expr) nil)
125     ;; second condition     ;; second condition
126     ((listp expr)     ((listp expr)
127      (let ((fir (first expr)))      (when (erblisp-check-args expr)
128        (cond        (let ((fir (first expr)))
129         ((listp fir)          (cond
130          (cons (erblisp-sandbox fir)           ((listp fir)
131                (mapcar 'erblisp-sandbox (cdr expr))))            (cons (erblisp-sandbox fir)
132         ((equal (format "%S" fir) "quote")                  (mapcar 'erblisp-sandbox (cdr expr))))
133          ;; if quoted, it is fine...           ((equal (format "%S" fir) "quote")
134          expr)            ;; if quoted, it is fine...
135         (t (cons            expr)
136             (if (or (equal 0 (string-match "fs-" (format "%S" fir)))           (t (cons
137                     (member fir erblisp-allowed-words))               (if (or (equal 0 (string-match "fs-" (format "%S" fir)))
138                 fir                       (member fir erblisp-allowed-words))
139               (intern (concat "fs-" (format "%S" fir))))                   fir
140             (mapcar 'erblisp-sandbox (cdr expr)))))))                 (intern (concat "fs-" (format "%S" fir))))
141                   (mapcar 'erblisp-sandbox (cdr expr)))))))
142    
143     ;; final condition.. --> when the expr is an atom..  It should be a     ;; final condition.. --> when the expr is an atom..  It should be a
144     ;; a constant..  or an allowed atom.. allowed == prefixed with fs-     ;; a constant..  or an allowed atom.. allowed == prefixed with fs-
# Line 137  We WON'T do this by default since this c Line 162  We WON'T do this by default since this c
162                 "What are you trying to feed me? Byte-compiled code? Vectors?"  ))                 "What are you trying to feed me? Byte-compiled code? Vectors?"  ))
163         (t expr)))         (t expr)))
164     ))     ))
           
165    
166  (defun erblisp-sandbox-fuzzy (expr)  (defun erblisp-sandbox-fuzzy (expr)
167    "Sandboxes a message.. Ensures that the functions are all fs-    "Sandboxes a message.. Ensures that the functions are all fs-

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26