From c9c9429fc4ab2933f6b52530ae4fb2fe47d0096b Mon Sep 17 00:00:00 2001
From: Ray Miller <ray@1729.org.uk>
Date: Fri, 3 Jan 2025 20:07:02 +0000
Subject: [PATCH] Add podman connection (incomplete)

---
 modules/ordo/connection.scm | 38 +++++++++++++++++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

diff --git a/modules/ordo/connection.scm b/modules/ordo/connection.scm
index c4b48ae..4deddb2 100644
--- a/modules/ordo/connection.scm
+++ b/modules/ordo/connection.scm
@@ -15,6 +15,7 @@
   #:use-module (srfi srfi-197) ;; chain
   #:export (local-connection
             ssh-connection
+            ;;podman-connection
             init!
             close!
             run
@@ -41,9 +42,16 @@
 (define* (ssh-connection user host #:key (sudo? #f))
   (make <ssh-connection> #:user user #:host host #:sudo? sudo?))
 
-(define-method (init! (c <local-connection>)) #t)
+;; (define-class <podman-connection> (<connection>)
+;;   (container-name #:getter get-container-name #:init-keyword #:container)
+;;   (user #:getter get-user #:init-keyword #:user #:init-value #f))
 
-(define-method (close! (c <local-connection>)) #t)
+;; (define* (podman-connection #:key (sudo? #f))
+;;   (make <podman-connection> #:sudo? sudo?))
+
+(define-method (init! c) #t)
+
+(define-method (close! c) #t)
 
 (define-method (init! (c <ssh-connection>))
   (unless (slot-bound? c 'session)
@@ -88,6 +96,23 @@
     (close channel)
     (values output exit-status)))
 
+;; (define-method (build-podman-exec (c <podman-connection> pwd env prog args)
+;;                                   (chain-when '()
+;;                                               ((sudo? c) (append _ "sudo"))
+;;                                               (#t (append _ '("podman" "exec")))
+;;                                               ((get-user c) (append (list "-u" (get-user c))))
+;;                                               (pwd (append _ '( "-w" pwd)))
+;;                                               (env (append _ (concatenate (map (lambda (x) (list "-e" (format #f "~a=~a" (car x) (cdr x)))) env))))
+;;                                               (#t (append (list container-name)))
+;;                                               (#t (append _ (cons prog args))))))
+
+;; (define-method (%run (c <podman-connection>) pwd env prog args)
+;;   (let* ((cmd (build-podman-exec c pwd env prog args)))
+;;     (port (apply open-pipe* OPEN_READ cmd))
+;;     (output (read-lines port))
+;;     (exit-status (status:exit-val (close-pipe port))))
+;;   (values output exit-status))
+
 (define (find-kw-arg kw kwargs)
   (let loop ((kwargs kwargs))
     (cond
@@ -131,6 +156,15 @@
       (error (format #f "error reading text file ~a@~a:~a" (get-user c) (get-host c) path)))
     output))
 
+;; (define-method (read-file (c <podman-connection>) (path <string>) (reader <procedure>))
+;;   (let* ((cmd (build-podman-exec c #f #f "cat" (list path)))
+;;          (port (apply open-pipe* OPEN_READ cmd))
+;;          (output (reader port))
+;;          (exit-status (status:exit-val (close-pipe port))))
+;;     (unless (zero? exit-status)
+;;       (error (format #f "error reading file ~a:~a" (get-container-name c) path)))
+;;     output))
+
 (define (read-text-file c path)
   (read-file c path get-string-all))