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

Add podman connection (incomplete)

Browse source
This commit is contained in:
Ray Miller 2025-01-03 20:07:02 +00:00
parent d7b49f2b3b
commit c9c9429fc4
Signed by: ray
GPG key ID: 043F786C4CD681B8
1 changed files with 36 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

38
modules/ordo/connection.scm
View file

@ -15,6 +15,7 @@
#:use-module (srfi srfi-197) ;; chain #:use-module (srfi srfi-197) ;; chain
#:export (local-connection #:export (local-connection
ssh-connection ssh-connection
;;podman-connection
init! init!
close! close!
run run
@ -41,9 +42,16 @@
(define* (ssh-connection user host #:key (sudo? #f)) (define* (ssh-connection user host #:key (sudo? #f))
(make <ssh-connection> #:user user #:host host #:sudo? sudo?)) (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>)) (define-method (init! (c <ssh-connection>))
(unless (slot-bound? c 'session) (unless (slot-bound? c 'session)
@ -88,6 +96,23 @@
(close channel) (close channel)
(values output exit-status))) (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) (define (find-kw-arg kw kwargs)
(let loop ((kwargs kwargs)) (let loop ((kwargs kwargs))
(cond (cond
@ -131,6 +156,15 @@
(error (format #f "error reading text file ~a@~a:~a" (get-user c) (get-host c) path))) (error (format #f "error reading text file ~a@~a:~a" (get-user c) (get-host c) path)))
output)) 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) (define (read-text-file c path)
(read-file c path get-string-all)) (read-file c path get-string-all))