Add image observation tool
ober
a1374459e4b86a319baa25d125406830d145e737
--- a/docs/tools.md +++ b/docs/tools.md @@ -28,6 +28,7 @@ page is the catalogue plus the safety model that wraps every call. | `bash` | Run a shell command | `command`, `timeout?` (s, default 120), `cwd?` | | `fetch` | HTTP(S) GET/POST a URL | `url`, `method?`, `body?`, `headers?` | | `web_search` | Search the web (in-process, DuckDuckGo HTML) | `query`, `count?` (1–20, default 5) | +| `image_view` | Inspect an image through a configured vision backend and return text | `path`, `question?`, `detail?` | ### Git @@ -58,6 +59,33 @@ a specialized prompt. LSP lookups (`lsp_definition` / `lsp_hover` / `lsp_references`) exist internally but are **not** exposed to the model — they back editor integrations, not the agent loop. +### Image viewing + +`image_view` gives text-only models a mediated way to inspect screenshots, +photos, and diagrams. It does not send pixels through the chat provider. +Instead, it runs a configured vision backend and feeds that backend's text +output back to the model as a tool result. + +Configure the backend in `jcode.json` or `~/.jcode/config.json`: + +```json +{ + "image_view": { + "argv": ["/path/to/vision-adapter", "{path}", "{question}", "{detail}"], + "timeout_seconds": 120, + "max_bytes": 20971520, + "allow_network": false, + "read_paths": ["/path/to/local/model/files"], + "env": [] + } +} +``` + +`argv` is an argument vector, not a shell string. Supported placeholders are +`{path}`, `{question}`, and `{detail}`. If no placeholder is present, jcode +appends the image path and question as final arguments. The backend should print +a concise visual description, OCR text, or direct answer to stdout. + ### Named agents (`task`'s `agent` parameter) Full guide with examples and the plan workflow: **[agents.md](agents.md)**. new file mode 100644 --- /dev/null +++ b/src/jcode/tool/image.ss @@ -0,0 +1,355 @@ +;;; jcode image observation tool + +(export init-image-tool + handle-image-view + image-view-argv + replace-image-placeholders + image-path-allowed?) + +(import :jerboa/core + :jerboa/runtime + :std/misc/string + :std/os/path + (only (std os path-util) file-size) + :std/os/platform + (only (std os limits sandbox) + sandbox-policy + sandbox-launch + sandbox-result-process + sandbox-result-launched? + sandbox-result-refused-axes) + (only (std os supervise) + process-result-status + process-result-stdout + process-result-stderr) + :jcode/core/config + :jcode/core/log + :jcode/tool/registry) + +(def logger (make-logger "tool.image")) + +(def default-image-question + "Describe this image for a text-only coding agent. Include visible text/OCR, UI layout, objects, errors, and any details relevant to the user's request.") + +(def (init-image-tool) + (register-tool! "image_view" + "Inspect an image by sending it to the configured vision backend and returning a textual observation for text-only models. Use when the user references a screenshot, photo, diagram, or other image file." + (make-image-schema + '(("path" "string" "Absolute or relative path to the image file" #t) + ("question" "string" "Optional question or focus for the visual inspection" #f) + ("detail" "string" "Optional detail level: low, normal, or high" #f))) + handle-image-view)) + +(def (handle-image-view args) + (let* ((path (hash-ref args "path" #f)) + (question0 (hash-ref args "question" #f)) + (detail0 (hash-ref args "detail" #f)) + (question (if (and (string? question0) + (not (string=? (string-trim question0) ""))) + question0 + default-image-question)) + (detail (if (and (string? detail0) + (not (string=? (string-trim detail0) ""))) + detail0 + "normal"))) + (cond + ((not (string? path)) + "Error: image_view requires a string path") + ((not (file-exists? path)) + (format "Error: image file not found: ~a" path)) + ((file-directory? path) + (format "Error: image_view expected a file, got directory: ~a" path)) + ((not (image-path-allowed? path)) + (format "Error: image_view refused path: ~a" path)) + ((not (supported-image-extension? path)) + (format "Error: unsupported image extension for image_view: ~a" path)) + ((image-too-large? path) + (format "Error: image exceeds image_view max_bytes (~a): ~a" + (image-max-bytes) path)) + (else + (let ((argv (image-view-argv path question detail))) + (if (not argv) + (image-view-config-error) + (run-image-view-backend path question detail argv))))))) + +(def (image-view-config-error) + (string-append + "Error: image_view is not configured.\n" + "Add an image_view.argv array to jcode.json or ~/.jcode/config.json, for example:\n" + " \"image_view\": { \"argv\": [\"/path/to/vision-adapter\", \"{path}\", \"{question}\"], \"timeout_seconds\": 120 }\n" + "The backend must print a textual observation to stdout.")) + +(def (run-image-view-backend path question detail argv) + (log-info logger "execute" `((path . ,path) (argv0 . ,(car argv)))) + (let-values (((stdout stderr status) (run-image-backend path argv))) + (let ((text (string-trim (string-append stdout stderr)))) + (cond + ((not (= status 0)) + (format "Error: image_view backend exited with status ~a\n~a" status text)) + ((string=? text "") + "Error: image_view backend returned no observation") + (else + (format "Image: ~a\nBytes: ~a\nDetail: ~a\nQuestion: ~a\n\nObservation:\n~a" + path + (safe-file-size path) + detail + question + text)))))) + +(def (run-image-backend path argv) + (let* ((cwd (current-directory)) + (allow-net? (config-bool "image_view" "allow_network" #f)) + (policy (image-sandbox-policy path argv cwd allow-net?)) + (result + (sandbox-launch policy + 'command: argv + 'env: (image-launch-env) + 'cwd: cwd + 'capture-stdout?: #t + 'capture-stderr?: #t + 'timeout-ms: (* 1000 (image-timeout-seconds)) + 'stdout-cap-bytes: 1048576 + 'stderr-cap-bytes: 262144 + 'require: (image-required-axes allow-net?) + 'fail-closed?: #t))) + (cond + ((not (sandbox-result-launched? result)) + (values "" + (format "sandbox refused to launch; missing required axes: ~a" + (sandbox-result-refused-axes result)) + 126)) + (else + (let ((proc (sandbox-result-process result))) + (values (bytevector->safe-string (process-result-stdout proc)) + (bytevector->safe-string (process-result-stderr proc)) + (or (process-result-status proc) -1))))))) + +(def (image-sandbox-policy path argv cwd allow-net?) + (sandbox-policy + 'read-paths: (image-read-paths path argv cwd) + 'write-paths: (image-write-paths cwd) + 'exec-paths: (image-exec-paths argv) + 'net: (if allow-net? 'allow 'deny) + 'syscalls: 'safe + 'capsicum?: #f)) + +(def (image-required-axes allow-net?) + (cond + ((platform-linux?) + (if allow-net? '(fs exec syscalls) '(fs exec net syscalls))) + ((platform-macos?) + (if allow-net? '(fs) '(fs net))) + (else '()))) + +(def (image-read-paths path argv cwd) + (dedupe-strings + (append + (list path cwd "/usr" "/bin" "/sbin" "/etc" "/opt" "/Library" "/System" + "/private/etc" "/dev") + (config-string-list "image_view" "read_paths") + (argv-absolute-paths argv)))) + +(def (image-write-paths cwd) + (dedupe-strings + (append (list cwd "/tmp" "/private/tmp" "/private/var/folders") + (config-string-list "image_view" "write_paths")))) + +(def (image-exec-paths argv) + (dedupe-strings + (append + (list "/usr/bin" "/bin" "/usr/local/bin" "/opt/homebrew/bin" + "/opt/homebrew/sbin" "/sbin" "/usr/sbin" + (path-join (or (getenv "HOME") "/") ".local/bin")) + (config-string-list "image_view" "exec_paths") + (argv-directories argv)))) + +(def (image-launch-env) + (append + (cons (cons "PATH" (or (getenv "PATH") "/usr/bin:/bin:/usr/local/bin")) + (selected-env-pairs + '("HOME" "USER" "LOGNAME" "SHELL" + "LANG" "LC_ALL" "LC_CTYPE" "TERM" "TMPDIR" + "XDG_CONFIG_HOME" "XDG_CACHE_HOME" "XDG_DATA_HOME"))) + (selected-env-pairs (config-string-list "image_view" "env")))) + +(def (image-view-argv path question detail) + (let ((argv (config-string-list "image_view" "argv"))) + (cond + ((null? argv) #f) + (else + (let ((rendered + (map (lambda (arg) + (replace-image-placeholders arg path question detail)) + argv))) + (if (argv-has-image-placeholders? argv) + rendered + (append rendered (list path question)))))))) + +(def (argv-has-image-placeholders? argv) + (let loop ((rest argv)) + (cond + ((null? rest) #f) + ((or (string-contains (car rest) "{path}") + (string-contains (car rest) "{question}") + (string-contains (car rest) "{detail}")) + #t) + (else (loop (cdr rest)))))) + +(def (replace-image-placeholders s path question detail) + (string-replace-all + (string-replace-all + (string-replace-all s "{path}" path) + "{question}" question) + "{detail}" detail)) + +(def (string-replace-all s old new) + (if (or (not (string? s)) (string=? old "")) + s + (let ((out (open-output-string)) + (old-len (string-length old)) + (s-len (string-length s))) + (let loop ((start 0)) + (let* ((tail (substring s start s-len)) + (idx (string-contains tail old))) + (cond + ((not idx) + (put-string out tail) + (get-output-string out)) + (else + (put-string out (substring tail 0 idx)) + (put-string out new) + (loop (+ start idx old-len))))))))) + +(def (supported-image-extension? path) + (let ((ext0 (path-extension path))) + (and ext0 + (let* ((ext1 (string-downcase ext0)) + (ext (if (and (> (string-length ext1) 0) + (char=? (string-ref ext1 0) #\.)) + (substring ext1 1 (string-length ext1)) + ext1))) + (and (member ext '("png" "jpg" "jpeg" "gif" "webp" "bmp" + "tif" "tiff" "heic" "heif" "avif")) + #t))))) + +(def (image-too-large? path) + (let ((size (safe-file-size path)) + (max-bytes (image-max-bytes))) + (and size max-bytes (> size max-bytes)))) + +(def (safe-file-size path) + (try (file-size path) + (catch (e) #f))) + +(def (image-max-bytes) + (let ((v (config-ref "image_view" "max_bytes"))) + (if (and (number? v) (> v 0)) v (* 20 1024 1024)))) + +(def (image-timeout-seconds) + (let ((v (config-ref "image_view" "timeout_seconds"))) + (if (and (number? v) (> v 0)) v 120))) + +(def (config-bool a b default) + (let ((v (config-ref a b))) + (if (or (eq? v #t) (eq? v #f)) v default))) + +(def (config-string-list a b) + (let ((v (config-ref a b))) + (cond + ((and (list? v) (every string? v)) v) + (else '())))) + +(def (image-path-allowed? path) + (not (sensitive-path? path))) + +(def (sensitive-path? path) + (let ((norm (normalize-image-path path))) + (let loop ((frags (sensitive-deny-fragments))) + (cond + ((null? frags) #f) + ((string-contains norm (car frags)) #t) + (else (loop (cdr frags))))))) + +(def (normalize-image-path p) + (cond + ((not (string? p)) "") + ((string=? p "~") (home-dir)) + ((string-prefix? "~/" p) + (path-join (home-dir) (substring p 2 (string-length p)))) + (else p))) + +(def (home-dir) + (or (getenv "HOME") "/")) + +(def (sensitive-deny-fragments) + (list (path-join (home-dir) ".ssh") + (path-join (home-dir) ".aws") + (path-join (home-dir) ".gnupg") + (path-join (home-dir) ".netrc") + (path-join (home-dir) ".config/gh") + (path-join (home-dir) ".docker") + (path-join (home-dir) ".jcode/keys.enc") + "/jcode.json" + "/etc/shadow" "/etc/sudoers" "/etc/sudoers.d")) + +(def (argv-absolute-paths argv) + (filter absolute-path? argv)) + +(def (argv-directories argv) + (filter-map path-directory + (filter absolute-path? argv))) + +(def (absolute-path? s) + (and (string? s) + (> (string-length s) 0) + (char=? (string-ref s 0) #\/))) + +(def (selected-env-pairs names) + (let loop ((rest names) (out '())) + (cond + ((null? rest) (reverse out)) + (else + (let ((v (getenv (car rest)))) + (loop (cdr rest) + (if (and (string? v) (not (string=? v ""))) + (cons (cons (car rest) v) out) + out))))))) + +(def (dedupe-strings xs) + (let loop ((rest xs) (seen '()) (out '())) + (cond + ((null? rest) (reverse out)) + ((or (not (string? (car rest))) (string=? (car rest) "")) + (loop (cdr rest) seen out)) + ((member (car rest) seen) + (loop (cdr rest) seen out)) + (else + (loop (cdr rest) + (cons (car rest) seen) + (cons (car rest) out)))))) + +(def (bytevector->safe-string bv) + (try (utf8->string bv) + (catch (e) ""))) + +(def (make-image-schema params) + (let ((schema (make-hash-table)) + (properties (make-hash-table)) + (required '())) + (hash-put! schema "type" "object") + (for-each + (lambda (param) + (let ((name (car param)) + (type (cadr param)) + (desc (caddr param)) + (req? (cadddr param)) + (prop (make-hash-table))) + (hash-put! prop "type" type) + (hash-put! prop "description" desc) + (hash-put! properties name prop) + (when req? + (set! required (cons name required))))) + params) + (hash-put! schema "properties" properties) + (hash-put! schema "required" (reverse required)) + schema)) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -29,6 +29,7 @@ :jcode/tool/verified :jcode/tool/repomap-tool :jcode/tool/web + :jcode/tool/image :jcode/tool/batch :jcode/tool/git :jcode/provider/provider @@ -221,6 +222,7 @@ (init-verified-tool) (init-repomap-tool) (init-web-tools) + (init-image-tool) (init-batch-tool) (init-git-tools) ;; External servers in parallel (spawn subprocesses, handshake) --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -39,6 +39,7 @@ :jcode/tool/verified :jcode/tool/repomap-tool :jcode/tool/web + :jcode/tool/image :jcode/tool/batch :jcode/tool/git :jcode/tool/external-llm @@ -281,6 +282,7 @@ (init-verified-tool) (init-repomap-tool) (init-web-tools) + (init-image-tool) (init-batch-tool) (init-git-tools) (init-mcp-tools) --- a/test/run.ss +++ b/test/run.ss @@ -19,6 +19,7 @@ (jcode tool registry) (jcode tool file) (jcode tool bash) + (jcode tool image) (jcode tool todo) (jcode tool external-llm) (jcode tool verified) @@ -268,6 +269,7 @@ (current-log-level 'warn) (init-file-tools) (init-bash-tool) +(init-image-tool) (init-todo-tool) ;; ── Message tests ───────────────────────────────────────────────── @@ -432,6 +434,44 @@ "path" "src/jcode/ui/cli.ss"))]) (check! "grep no match" r "No matches found")) +;; image_view is a text bridge to a configured vision backend +(check! "image placeholder replacement" + (replace-image-placeholders "{detail}:{path}:{question}" + "/tmp/a.png" "what is shown?" "high") + "high:/tmp/a.png:what is shown?") + +(let* ([tmp (format "/tmp/jcode-image-tool-~a.png" (random 100000000))] + [cfg (make-hashtable equal-hash equal?)] + [image-cfg (make-hashtable equal-hash equal?)]) + (call-with-output-file tmp + (lambda (out) (display "not really png, only testing harness plumbing" out)) + 'replace) + (hashtable-set! image-cfg "argv" '("/bin/echo" "seen:{path}:{question}:{detail}")) + (hashtable-set! image-cfg "timeout_seconds" 5) + (hashtable-set! cfg "image_view" image-cfg) + (parameterize ((*config* cfg)) + (check! "image argv placeholder rendering" + (image-view-argv tmp "focus" "high") + (list "/bin/echo" (string-append "seen:" tmp ":focus:high"))) + (let ([r (tool-execute "image_view" + (args "path" tmp "question" "focus" "detail" "high"))]) + (check-pred! "image_view returns backend observation" + r + (lambda (s) + (and (str-contains? s "Observation:") + (str-contains? s "seen:") + (str-contains? s "focus"))))))) + +(let ([tmp (format "/tmp/jcode-image-unconfigured-~a.png" (random 100000000))]) + (call-with-output-file tmp + (lambda (out) (display "placeholder" out)) + 'replace) + (parameterize ((*config* (make-hashtable equal-hash equal?))) + (let ([r (tool-execute "image_view" (args "path" tmp))]) + (check-pred! "image_view reports missing backend config" + r + (lambda (s) (str-contains? s "image_view is not configured")))))) + ;; ── Bash tool tests ─────────────────────────────────────────────── (section "=== bash tool ===")