From 44f927e8f19378ec148e16f0dd0f3f5437400237 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Fri, 8 May 2026 19:30:51 -0400 Subject: [PATCH] =?UTF-8?q?v0.7.2:=20wire=20with-tool-timeout=20into=20act?= =?UTF-8?q?ion-tool-execute=20=E2=80=94=20TDD?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit call-with-tool-timeout wraps tool execution with sb-ext:with-timeout using per-tool timeout from *tool-timeouts*. On timeout returns (:status :error :message "Timed out after Ns"). Wired into action-tool-execute before the funcall. Timeout result detected and propagated as :tool-error. - core-act: call-with-tool-timeout fn, wired into action-tool-execute - Act tests: +3 (timeout enforcement test) - Core: 88/88 --- lisp/core-act.lisp | 46 +++++++++++++++++++++++++++++++++++++++++++--- org/core-act.org | 46 +++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 86 insertions(+), 6 deletions(-) diff --git a/lisp/core-act.lisp b/lisp/core-act.lisp index 4578e1b..fc7b39e 100644 --- a/lisp/core-act.lisp +++ b/lisp/core-act.lisp @@ -87,13 +87,20 @@ (if tool (handler-case (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) - (result (funcall (cognitive-tool-body tool) clean-args))) + (raw-result (call-with-tool-timeout tool-name + (lambda () (funcall (cognitive-tool-body tool) clean-args))))) + ;; Timeout: propagate error + (when (and (listp raw-result) (eq (getf raw-result :status) :error)) + (return-from action-tool-execute + (list :TYPE :EVENT :DEPTH (1+ depth) :META meta + :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name + :MESSAGE (getf raw-result :message))))) (when source (action-dispatch (list :TYPE :REQUEST :TARGET source - :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name result))) + :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name raw-result))) context)) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta - :PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))) + :PAYLOAD (list :SENSOR :tool-output :RESULT raw-result :TOOL tool-name))) (error (c) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name :MESSAGE (format nil "~a" c))))) @@ -112,6 +119,18 @@ "Return timeout for tool-name, default 120 seconds." (gethash (string-downcase (string tool-name)) *tool-timeouts* 120)) +(defun call-with-tool-timeout (tool-name fn) + "Execute FN within the timeout for TOOL-NAME. +On timeout, returns (:status :error :message ...)." + (let ((timeout (tool-timeout tool-name))) + (handler-case + (sb-ext:with-timeout timeout + (funcall fn)) + (sb-ext:timeout (c) + (declare (ignore c)) + (list :status :error :message + (format nil "Timed out after ~a second~:p" timeout)))))) + (defun verify-write (filepath expected-content) "Verify that FILEPATH contains EXPECTED-CONTENT after write. Returns T on match, logs and returns NIL on mismatch or read error." @@ -271,3 +290,24 @@ For approval-required actions, creates a Flight Plan instead of executing." (unwind-protect (is (passepartout::verify-write path content)) (ignore-errors (delete-file path))))) + +(test test-tool-timeout-enforcement + "Contract v0.7.2: tool exceeding timeout returns :error with timeout message." + (setf (gethash "sleep-forever" passepartout::*tool-timeouts*) 1) + (setf (gethash "sleep-forever" passepartout::*cognitive-tool-registry*) + (passepartout::make-cognitive-tool :name "sleep-forever" + :read-only-p nil + :body (lambda (args) + (declare (ignore args)) + (sleep 10) + "done"))) + (unwind-protect + (let* ((action '(:type :REQUEST :payload (:tool "sleep-forever" :args nil))) + (ctx '(:depth 0)) + (result (passepartout::action-tool-execute action ctx))) + (is (eq :EVENT (getf result :TYPE))) + (let ((payload (getf result :PAYLOAD))) + (is (eq :tool-error (getf payload :SENSOR))) + (is (search "timed out" (string-downcase (getf payload :MESSAGE)))))) + (remhash "sleep-forever" passepartout::*cognitive-tool-registry*) + (remhash "sleep-forever" passepartout::*tool-timeouts*))) diff --git a/org/core-act.org b/org/core-act.org index af2c547..03a53b5 100644 --- a/org/core-act.org +++ b/org/core-act.org @@ -186,13 +186,20 @@ The tool's return value is packed into a ~:tool-output~ event and fed back into (if tool (handler-case (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) - (result (funcall (cognitive-tool-body tool) clean-args))) + (raw-result (call-with-tool-timeout tool-name + (lambda () (funcall (cognitive-tool-body tool) clean-args))))) + ;; Timeout: propagate error + (when (and (listp raw-result) (eq (getf raw-result :status) :error)) + (return-from action-tool-execute + (list :TYPE :EVENT :DEPTH (1+ depth) :META meta + :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name + :MESSAGE (getf raw-result :message))))) (when source (action-dispatch (list :TYPE :REQUEST :TARGET source - :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name result))) + :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name raw-result))) context)) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta - :PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))) + :PAYLOAD (list :SENSOR :tool-output :RESULT raw-result :TOOL tool-name))) (error (c) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name :MESSAGE (format nil "~a" c))))) @@ -214,6 +221,18 @@ The tool's return value is packed into a ~:tool-output~ event and fed back into "Return timeout for tool-name, default 120 seconds." (gethash (string-downcase (string tool-name)) *tool-timeouts* 120)) +(defun call-with-tool-timeout (tool-name fn) + "Execute FN within the timeout for TOOL-NAME. +On timeout, returns (:status :error :message ...)." + (let ((timeout (tool-timeout tool-name))) + (handler-case + (sb-ext:with-timeout timeout + (funcall fn)) + (sb-ext:timeout (c) + (declare (ignore c)) + (list :status :error :message + (format nil "Timed out after ~a second~:p" timeout)))))) + (defun verify-write (filepath expected-content) "Verify that FILEPATH contains EXPECTED-CONTENT after write. Returns T on match, logs and returns NIL on mismatch or read error." @@ -408,4 +427,25 @@ Verifies that the act gate correctly processes an approved action and sets the s (unwind-protect (is (passepartout::verify-write path content)) (ignore-errors (delete-file path))))) + +(test test-tool-timeout-enforcement + "Contract v0.7.2: tool exceeding timeout returns :error with timeout message." + (setf (gethash "sleep-forever" passepartout::*tool-timeouts*) 1) + (setf (gethash "sleep-forever" passepartout::*cognitive-tool-registry*) + (passepartout::make-cognitive-tool :name "sleep-forever" + :read-only-p nil + :body (lambda (args) + (declare (ignore args)) + (sleep 10) + "done"))) + (unwind-protect + (let* ((action '(:type :REQUEST :payload (:tool "sleep-forever" :args nil))) + (ctx '(:depth 0)) + (result (passepartout::action-tool-execute action ctx))) + (is (eq :EVENT (getf result :TYPE))) + (let ((payload (getf result :PAYLOAD))) + (is (eq :tool-error (getf payload :SENSOR))) + (is (search "timed out" (string-downcase (getf payload :MESSAGE)))))) + (remhash "sleep-forever" passepartout::*cognitive-tool-registry*) + (remhash "sleep-forever" passepartout::*tool-timeouts*))) #+end_src \ No newline at end of file