From: jsancho 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))