ray/ordo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Bugfix interceptor and add example

Browse source
This commit is contained in:
Ray Miller 2025-01-23 17:08:06 +00:00
parent f49be4af29
commit 63b9ad6753
Signed by: ray
GPG key ID: 043F786C4CD681B8
6 changed files with 155 additions and 101 deletions
Download patch file Download diff file Expand all files Collapse all files

71
examples/interceptor.scm
View file

@ -1,66 +1,31 @@
(use-modules
(ice-9 filesystem)
(oop goops)
(logging logger)
(srfi srfi-26)
(ordo logger)
(ordo interceptor)
(ordo connection)
(ordo connection sudo)
(ordo action filesystem))
(define* (i:connection c #:key sudo? sudo-user sudo-password)
"Interceptor to manage the current connection."
(interceptor
"manage-connection"
#:enter (lambda (ctx)
(let ((c (if sudo?
(make <sudo-connection> #:connection c #:become-user sudo-user #:become-password sudo-password)
c)))
(conn:setup c)
(set-context-connection! ctx c)))
#:leave (lambda (ctx)
(and=> (context-connection ctx) conn:teardown)
(set-context-connection! ctx #f))))
(define (i:handle-errors)
"Interceptor to log (and clear) the context error. This will allow any
earlier #:leave handlers in the chain to run normally."
(interceptor
"handle-errors"
#:error (lambda (ctx)
(and=> (context-error ctx) (cut log-msg 'ERROR <>))
(set-context-error! ctx #f))))
(define (i:tmp-dir)
"Interceptor to manage a temporary directory."
(interceptor
"tmp-dir"
#:enter (lambda (ctx)
(var-set! ctx 'tmp-dir (fs:create-tmp-dir (context-connection ctx))))
#:leave (lambda (ctx)
(and=> (var-ref ctx 'tmp-dir #f)
(cut fs:remove (context-connection ctx) <> #:recurse? #t))
(var-delete! ctx 'tmp-dir))))
(ordo interceptor)
(ordo interceptor tmp-dir)
(ordo interceptor debug)
(ordo action filesystem)
(ordo logger))
(define chain
(list (i:connection (local-connection))
(i:tmp-dir)
(i:handle-errors)
(list (connection-interceptor (local-connection))
(tmp-dir-interceptor #:tmp-dir)
(interceptor
"hello-world"
"install hello"
#:enter (lambda (ctx)
(var-set! ctx 'hello
(fs:install-file (context-connection ctx)
(file-name-join* (var-ref ctx 'tmp-dir)
"hello.txt")
#:content "Hello, world!\n"))))
(fs:install-file (context-connection ctx)
(file-name-join* (var-ref ctx #:tmp-dir) "hello.txt")
#:content "Hello, world!\n"))
#:register #:hello)
(interceptor
"get-file-status"
"stat hello"
#:enter (lambda (ctx)
(let ((st (fs:stat (context-connection ctx) (var-ref ctx 'hello))))
(log-msg 'INFO "stat result: " st))))))
(fs:stat (context-connection ctx) (var-ref ctx #:hello)))
#:register #:hello-stat)
(debug-vars-interceptor #:hello #:hello-stat)
(debug-vars-interceptor)))
(setup-logging #:level 'DEBUG)
(setup-logging #:level 'INFO)
(execute (init-context) chain)
(shutdown-logging)