Treat scoped mutation refusals as recoverable
Jaime Fournier <jaimef@linbsd.org>
4f55b5554aa608f7b9ae45981076fd5b44aa6966
diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index 7a2503e..b7d5800 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -5878,7 +5878,12 @@
((placeholder-only-content? content)
(guard-placeholder-content! 'replace_range path content))
((write-scope-error "replace_range" (scope-path cwd path))
- => (lambda (msg) (error 'replace_range msg)))
+ => (lambda (msg)
+ (raise-recoverable-tool-error
+ (string-append
+ msg
+ ". The file was not changed. This task can only write inside the configured scope; create or repair the allowed target file instead.")
+ 'replace_range)))
((verified-mutation-policy-error "replace_range" cwd path)
=> (lambda (msg) (error 'replace_range msg)))
((path-has-symlink-component? cwd path)
@@ -5979,7 +5984,12 @@
((placeholder-only-content? (or new-str content))
(guard-placeholder-content! 'edit path (or new-str content)))
((write-scope-error "edit" (scope-path cwd path))
- => (lambda (msg) (error 'edit msg)))
+ => (lambda (msg)
+ (raise-recoverable-tool-error
+ (string-append
+ msg
+ ". The file was not changed. This task can only write inside the configured scope; create or repair the allowed target file instead.")
+ 'edit)))
((verified-mutation-policy-error "edit" cwd path)
=> (lambda (msg) (error 'edit msg)))
((path-has-symlink-component? cwd path)
@@ -6532,7 +6542,12 @@
(error 'create_verified_jerboa_script
(format "path must end in .ss for a Jerboa script: ~a" path)))
((write-scope-error "create_verified_jerboa_script" (scope-path cwd path))
- => (lambda (msg) (error 'create_verified_jerboa_script msg)))
+ => (lambda (msg)
+ (raise-recoverable-tool-error
+ (string-append
+ msg
+ ". The file was not changed. This task can only write inside the configured scope; create or repair the allowed target file instead.")
+ 'create_verified_jerboa_script)))
((path-has-symlink-component? cwd path)
(error 'create_verified_jerboa_script
(format "refusing write through symlink path component: ~a"
diff --git a/test/run.ss b/test/run.ss
index 9db5e31..83d96ea 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -8245,6 +8245,54 @@
(safe-delete-test-file! target-path))
(let* ([vr-dir "/tmp"]
+ [target "jcode-out-of-scope-recoverable.txt"]
+ [target-path (string-append vr-dir "/" target)]
+ [tool-results '()]
+ [resp (scripted-responder
+ (list
+ (list
+ (make-wtool-call
+ "edit"
+ (list (cons "path" "/tmp/not-the-target.ss")
+ (cons "content" "wrong"))
+ #f))
+ (list
+ (make-wtool-call
+ "write"
+ (list (cons "path" target)
+ (cons "content" "correct"))
+ #f))
+ (list (make-wtool-call "verify" '() #f))
+ (list (make-wtool-call "done" '(("summary" . "scope-recovered")) #f))))]
+ [scope (parse-write-scope target)]
+ [wf (coding-workflow (string-append "grep -q correct " target)
+ vr-dir
+ (list (cons 'write-scope scope)))]
+ [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])
+ (safe-delete-test-file! target-path)
+ (let ([result (parameterize ((current-write-scope scope))
+ (run-workflow wf "recover from out-of-scope edit" resp
+ (list (cons 'max-iterations 8)
+ (cons 'max-tool-errors 0)
+ (cons 'on-message
+ (lambda (m)
+ (when (equal? (message-role m) "tool")
+ (set! tool-results
+ (cons (message-content m) tool-results))))))))])
+ (check! "verified-run: out-of-scope edit recovery reaches done"
+ result "scope-recovered")
+ (check-pred! "verified-run: out-of-scope edit is recoverable"
+ (reverse tool-results)
+ (lambda (xs)
+ (and (pair? xs)
+ (str-contains? (car xs) "[ToolRecoverableError]")
+ (str-contains? (car xs) "outside")
+ (str-contains? (car xs) "allowed target file"))))
+ (check! "verified-run: out-of-scope recovery writes target"
+ (slurp target-path) "correct"))
+ (safe-delete-test-file! target-path))
+
+(let* ([vr-dir "/tmp"]
[target "jcode-verified-qt-api-aliases.ss"]
[target-path (string-append vr-dir "/" target)]
[bad