Coverage report: /home/ellis/comp/core/lib/pod/podman.lisp

KindCoveredAll%
expression0107 0.0
branch06 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; lib/pod/podman.lisp --- Pod Manager
2
 
3
 ;;
4
 
5
 ;;; Code:
6
 (in-package :pod)
7
 
8
 (defvar *podman-config-directory* (merge-homedir-pathnames ".config/containers/"))
9
 
10
 (defvar *container* nil)
11
 
12
 (defun check-container (&optional (c *container*))
13
   (unless c
14
     (required-argument :container)))
15
 
16
 (defun podman-build (&key file tag no-cache)
17
   (apply 'run-podman "build" 
18
          `(,@(when file `("--file" ,(namestring file)))
19
            ,@(when tag `("--tag" ,tag))
20
            ,@(when no-cache `("--no-cache")))))
21
 
22
 (defun podman-exec (cmd &key dir (container *container*))
23
   (check-container container)
24
   (apply 'run-podman "exec"
25
          `(,@(when dir `("-w" ,(namestring dir)))
26
            ,container
27
            ,@(if (atom cmd) `(,cmd) cmd))))
28
 
29
 (defun podman-run (args &key dir (container *container*) name (tty t) (detach t) cmd (replace t) systemd ports)
30
   ;; attach cpu 
31
   ;; gpu health network 
32
   ;; mount memory hostname env
33
   ;; dns authfile cap cgroup
34
   ;; expose label log mac-address
35
   ;; pod publish quiet read-only
36
   ;; replace restart requires rm
37
   ;; secret systemd timeout tty
38
   ;; tz ulimit user volume
39
   (check-container container)
40
   (apply 'run-podman "exec"
41
          `(,@(when dir `("-w" ,(namestring dir)))
42
            ,@(when name `("--name" ,name))
43
            ,@(when tty `("--tty" ,tty))
44
            ,@(when detach `("--detach" ,detach))
45
            ,@(when cmd `("--cmd" ,cmd))
46
            ,@(when replace '("--replace"))
47
            ,@(when ports (flatten
48
                           (mapcar 
49
                            (lambda (x) 
50
                              (list "-p" 
51
                                    (if (consp x) 
52
                                        (format nil "~A:~A" (car x) (cdr x))
53
                                        x)))
54
                            ports)))
55
            ,@(when systemd '("--systemd=true"))
56
            ,container
57
            ,@(if (atom args) `(,args) args))))
58
 
59
 (defun podman-cp (src dst &key overwrite)
60
   (apply 'run-podman "cp" `(,@(when overwrite '("--overwrite")) ,(namestring src) ,(namestring dst))))
61
 
62
 (defun podman-stop (&optional (container *container*))
63
   (check-container container)
64
   (run-podman "stop" container))
65
 
66
 (defmacro with-container ((sym container &key run stop name dir tty detach cmd)
67
                           &body body)
68
   `(let ((,sym ,(if run 
69
                     `(podman-run ,run 
70
                                  ,@(when dir `(:dir ,dir))
71
                                  ,@(when tty `(:dir ,tty))
72
                                  ,@(when detach `(:dir ,detach))
73
                                  ,@(when cmd `(:cmd ,cmd))
74
                                  ,@(when name `(:name ,name))
75
                                  :container ,container)
76
                     container)))
77
      (setf *container* ,sym)
78
      ,@body
79
      ,@(when stop `((podman-stop ,sym)))))