Bugfixes and interceptor chain example.

examples/interceptor.scm

@@ -0,0 +1,66 @@
+(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))))
+
+(define chain
+  (list (i:connection (local-connection))
+        (i:tmp-dir)
+        (i:handle-errors)
+        (interceptor
+         "hello-world"
+         #: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"))))
+        (interceptor
+         "get-file-status"
+         #:enter (lambda (ctx)
+                   (let ((st (fs:stat (context-connection ctx) (var-ref ctx 'hello))))
+                     (log-msg 'INFO "stat result: " st))))))
+
+(setup-logging #:level 'DEBUG)
+(execute (init-context) chain)
+(shutdown-logging)