(no commit message)

diff --git a/gacela.lisp b/gacela.lisp
index 6a93356b0da12ecd5c331a0eb4267b9e126ba39e..d94e4685246edaa305112488eeca66ed7aa1cf29 100644 (file)
--- a/gacela.lisp
+++ b/gacela.lisp
@@ -215,12 +215,7 @@
   (defun eval-from-clients ()
     (dolist (cli clients)
       (when (si::listen cli)
-       (let ((sto *standard-output*))
-         (setq *standard-output* cli)
-         (setq *break-enable* nil)
-         (eval (read cli))
-         (setq *break-enable* t)
-         (setq *standard-output* sto)))))
+       (secure-block cli (eval (read cli))))))
 
   (defun stop-server ()
     (when socket

diff --git a/gacela_misc.lisp b/gacela_misc.lisp
index d9f38daa5ef4aedafbc7c3f8dfc1498db1efb560..9a017877b2391a30bd2fae934f760d8dea22c35a 100755 (executable)
--- a/gacela_misc.lisp
+++ b/gacela_misc.lisp
@@ -68,15 +68,18 @@
                        (t (power (* p 2) n)))))
          (power 1 n)))
 
-(defmacro secured-eval (form &optional output-stream)
+(defmacro secure-block (output-stream &rest forms)
   (let ((error-handler #'si::universal-error-handler))
     `(block secure
        (defun si::universal-error-handler (error-name correctable function-name continue-format-string error-format-string &rest args)
-        ,(when output-stream `(format ,output-stream error-format-string))
+        ,(when output-stream
+           `(format ,output-stream
+                    (cond ((eq error-name :WRONG-TYPE-ARGUMENT) (string error-name))
+                          (t error-format-string))))
         (setf (symbol-function 'si::universal-error-handler) ,error-handler)
         (return-from secure))
        (let (result-eval)
-        (setq result-eval (eval ,form))
+        (setq result-eval (progn ,@forms))
         (setf (symbol-function 'si::universal-error-handler) ,error-handler)
         result-eval))))
 

diff --git a/gacela_mobs.lisp b/gacela_mobs.lisp
index 0b844111098a4ce0d0c17227ba3496d228282af2..264b3e5c228b38b5b92193950b6b3cff0fa8e56e 100755 (executable)
--- a/gacela_mobs.lisp
+++ b/gacela_mobs.lisp
@@ -38,7 +38,7 @@
   (defun run-mobs (option &key args function)
     (dolist (mob running-mobs)
       (cond (function (funcall function)))
-      (apply (symbol-function mob) (cons option args))))
+      (secure-block nil (apply (symbol-function mob) (cons option args)))))
 
   (defun mob-off (mob)
     (push mob mobs-to-quit))
@@ -46,7 +46,7 @@
   (defun refresh-running-mobs ()
     (do ((mob (pop mobs-to-add) (pop mobs-to-add))) ((null mob))
        (push mob running-mobs)
-       (funcall (symbol-function mob) :init))
+       (secure-block nil (funcall (symbol-function mob) :init)))
     (setq running-mobs (reverse (set-difference running-mobs mobs-to-quit)))
     (setq mobs-to-quit nil))