v0.7.2: tool execution hardening — TDD

Per-tool timeouts: shell=300s, search-files=30s, eval-form=10s,
unknown=120s default. Write verification: after write-file,
reads back content and compares, logs mismatches.

- core-act: *tool-timeouts* hash, tool-timeout, verify-write
- programming-tools: verify-write call in write-file body
- Act tests: +3 (timeout shell, timeout unknown, verify match)
- Core: 84/84

lisp/core-act.lisp

@@ -98,7 +98,33 @@
             (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
                   :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name :MESSAGE (format nil "~a" c)))))
         (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
-              :PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
+               :PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
+
+(defvar *tool-timeouts* (make-hash-table :test 'equal)
+  "Per-tool timeout in seconds. Default 120s.")
+
+;; Defaults: shell=300s, search-files=30s, eval-form=10s
+(setf (gethash "shell" *tool-timeouts*) 300)
+(setf (gethash "search-files" *tool-timeouts*) 30)
+(setf (gethash "eval-form" *tool-timeouts*) 10)
+
+(defun tool-timeout (tool-name)
+  "Return timeout for tool-name, default 120 seconds."
+  (gethash (string-downcase (string tool-name)) *tool-timeouts* 120))
+
+(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."
+  (handler-case
+      (let ((actual (uiop:read-file-string filepath)))
+        (if (string= expected-content actual)
+            t
+            (progn
+              (log-message "WRITE-VERIFY: Mismatch in ~a" filepath)
+              nil)))
+    (error (c)
+      (log-message "WRITE-VERIFY: Cannot read ~a: ~a" filepath c)
+      nil)))
 
 (defun tool-result-format (tool-name result)
   "Format a tool result for display."
@@ -227,3 +253,21 @@ For approval-required actions, creates a Flight Plan instead of executing."
   (let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
                                   '(:type :EVENT :depth 0))))
     (is (numberp result) "eval should return a number")))
+
+(test test-tool-timeout-shell
+  "Contract v0.7.2: shell timeout is 300 seconds."
+  (is (= 300 (passepartout::tool-timeout "shell"))))
+
+(test test-tool-timeout-unknown
+  "Contract v0.7.2: unknown tool gets default 120s."
+  (is (= 120 (passepartout::tool-timeout "nonexistent-tool"))))
+
+(test test-verify-write-match
+  "Contract v0.7.2: verify-write returns T on match."
+  (let ((path "/tmp/passepartout-verify-test.org")
+        (content "test content"))
+    (with-open-file (f path :direction :output :if-exists :supersede)
+      (write-string content f))
+    (unwind-protect
+         (is (passepartout::verify-write path content))
+      (ignore-errors (delete-file path)))))

lisp/programming-tools.lisp

@@ -101,10 +101,11 @@
                    (content (getf args :content)))
               (unless (and filepath content)
                 (return (list :status :error :message "write-file requires :filepath and :content")))
-              (handler-case
-                  (progn
-                    (tools-write-file filepath content)
-                    (list :status :success
+               (handler-case
+                   (progn
+                     (tools-write-file filepath content)
+                     (verify-write filepath content)
+                     (list :status :success
                           :content (format nil "Written ~d bytes to ~a" (length content) filepath)))
                 (error (c) (list :status :error :message (format nil "~a" c))))))))