Disable nested task delegation
ober
c12b9f4f1251e5929a830e39b15ed0cbd3ffc8ef
--- a/src/jcode/tool/registry.ss +++ b/src/jcode/tool/registry.ss @@ -7,6 +7,7 @@ list-tools tool->openai-schema current-mode + current-disabled-tools mode-allows-tool? mode-blocked-message write-tool-name? @@ -32,6 +33,7 @@ ;; 'plan = read-only; write/exec tools are filtered out of the schema list ;; AND rejected at execute time as a safety net. (def current-mode (make-parameter 'build)) +(def current-disabled-tools (make-parameter '())) ;; Names of tools that mutate state (filesystem, processes, network sends, ;; git commits). Read-only tools (read, ls, glob, grep, git_status, git_diff, @@ -46,10 +48,16 @@ (or (eq? (current-mode) 'build) (not (write-tool-name? name)))) +(def (tool-disabled? name) + (and (member name (current-disabled-tools)) #t)) + (def (mode-blocked-message name) (format "Tool '~a' is blocked in PLAN mode (read-only). Switch to BUILD mode with /build to run write tools." name)) +(def (disabled-tool-message name) + (format "Tool '~a' is unavailable in this context." name)) + (def (register-write-tools! . names) ;; Allow tool modules to mark additional tool names as writers (e.g. plugins). (for-each @@ -92,6 +100,9 @@ (def (tool-execute name args) (log-info logger "execute" `((name . ,name) (mode . ,(current-mode)))) (cond + ((tool-disabled? name) + (log-warn logger "blocked-by-context" `((name . ,name))) + (disabled-tool-message name)) ((not (mode-allows-tool? name)) (log-warn logger "blocked-by-mode" `((name . ,name) (mode . ,(current-mode)))) (mode-blocked-message name)) @@ -125,13 +136,14 @@ (not (hash-get t "internal")) (mode-allows-tool? (hash-ref t "name" "")))) (map (lambda (name) (hash-get *tools* name)) - (hash-keys *tools*))))) + (list-tools))))) (def (list-tools) - (hash-keys *tools*)) + (filter (lambda (name) (not (tool-disabled? name))) + (hash-keys *tools*))) (def (tool-exists? name) - (and (hash-get *tools* name) #t)) + (and (not (tool-disabled? name)) (hash-get *tools* name) #t)) (def (tool-primary-arg name) ;; Return the first required arg name for a tool's schema, or #f. Used to --- a/src/jcode/tool/task.ss +++ b/src/jcode/tool/task.ss @@ -141,7 +141,8 @@ (def (with-agent-routing adef thunk) "Run THUNK with provider/model/write-scope routed per ADEF (silently capturing output — no streaming callbacks). The write scope can only - narrow: a scoped sub-agent spawning another task cannot widen access." + narrow. Sub-agents cannot spawn further task agents; nested delegation + loops are expensive and make local models appear hung." (let* ((aprov (and adef (agent-def-provider adef))) (amodel (and adef (agent-def-model adef))) (scope (write-scope-intersect @@ -156,7 +157,9 @@ (or amodel (and aprov (config-default-model aprov)) (current-model-override))) - (current-write-scope scope)) + (current-write-scope scope) + (current-disabled-tools + (cons "task" (current-disabled-tools)))) (try (thunk) (catch (e) (format "Sub-agent error: ~a" (err->string e))))))) --- a/test/run.ss +++ b/test/run.ss @@ -2097,6 +2097,26 @@ (write-scope-error "write" "src/x.ss") (lambda (s) (and (string? s) (str-contains? s "write scope"))))) +;; Context-disabled tools: sub-agents use this to hide task from prompts, +;; structured schemas, text-tool recovery, and direct execution. +(init-task-tool) +(parameterize ([current-disabled-tools '("task")]) + (check! "disabled task hidden from list-tools" + (and (member "task" (list-tools)) #t) #f) + (check! "disabled task hidden from tool-exists?" + (tool-exists? "task") #f) + (check! "disabled task hidden from schemas" + (let loop ([schemas (get-tool-schemas)]) + (cond [(null? schemas) #f] + [else + (let* ([fn (hashtable-ref (car schemas) "function" #f)] + [name (and fn (hashtable-ref fn "name" #f))]) + (if (equal? name "task") #t (loop (cdr schemas))))])) + #f) + (check-pred! "disabled task execution rejected" + (tool-execute "task" (args "description" "x" "prompt" "x")) + (lambda (s) (str-contains? s "unavailable in this context")))) + ;; Task session store: put / resume-shape / eviction cap. (task-session-clear!) (task-session-put! "t1" "delegate" '(m1 m2))