From: jsancho <devnull@localhost>
Date: Tue, 10 Nov 2009 12:45:08 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=713dfecf4536609800aa869bc1218b2dccc4d970;p=gacela.git

---

diff --git a/gacela.lisp b/gacela.lisp
index 6a93356..d94e468 100644
--- 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 d9f38da..9a01787 100755
--- 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 0b84411..264b3e5 100755
--- 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))