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

KindCoveredAll%
expression113189 59.8
branch78 87.5
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; containerfile.lisp --- Containerfiles
2
 
3
 ;; Containerfile read/write methods
4
 
5
 ;;; Commentary:
6
 
7
 ;; man: https://github.com/containers/common/blob/main/docs/Containerfile.5.md
8
 
9
 ;;; Code:
10
 (in-package :pod)
11
 
12
 ;;; Vars
13
 (defparameter *default-containerfile* "Containerfile")
14
 
15
 (defvar *containerfile-instructions*
16
   '(from arg maintainer run cmd label expose env add copy entrypoint volume user workdir onbuild))
17
 
18
 (deftype containerfile-instruction () `(member ,*containerfile-instructions*))
19
 
20
 (defvar *containerfile-predefined-args* 
21
   ;; lower-case version of these are also technically supported
22
   (list "HTTP_PROXY"
23
         "HTTPS_PROXY"
24
         "FTP_PROXY"
25
         "NO_PROXY"
26
         "ALL_PROXY"))
27
 
28
 ;;; Utils
29
 (defun write-containerfile-line (cons stream)
30
   (write (car cons) :stream stream)
31
   (write-char #\space stream)
32
   (write-line (cdr cons) stream))
33
 
34
 (defun read-containerfile-line (str)
35
   (let ((ws (position-if 'sb-unicode:whitespace-p str)))
36
     (cons (symbolicate (string-upcase (subseq str 0 ws)))
37
           (subseq str
38
                   (1+ ws)
39
                   (length str)))))
40
 
41
 (defun containerfile-comment-p (str)
42
   (char= #\# (aref str 0)))
43
 
44
 (defun containerfile-from-p (str)
45
   (starts-with-subseq "FROM" str))
46
 
47
 (defun read-containerfile-from (str)
48
   (subseq str (1+ (position-if 'sb-unicode:whitespace-p str))))
49
 
50
 (defun containerfile-arg-p (str)
51
   (starts-with-subseq "ARG" str))
52
 
53
 (defun format-containerfile-arg (arg)
54
   (with-output-to-string (s)
55
     (etypecase arg
56
       (atom (write arg :stream s))
57
       (cons (format s "~A=~A" (car arg) (cdr arg))))))
58
       
59
 (defun write-containerfile-arg (arg stream)
60
   (format stream "ARG ~A~%" (format-containerfile-arg arg)))
61
 
62
 (defun write-containerfile-from (base stream)
63
   (format stream "FROM ~A~%" base))
64
 
65
 ;; first instruction must be FROM or ARG
66
 (defun read-containerfile-start (stream)
67
   (let ((args))
68
     (loop for line = (trim (read-line stream nil nil))
69
           while line
70
           if (not (containerfile-from-p line))
71
           do (push line args)
72
           else if (containerfile-from-p line)
73
           do (return (values (read-containerfile-from line) (nreverse args))))))
74
 
75
 ;;; Obj
76
 (defclass containerfile ()
77
   ((path :initform (pathname *default-containerfile*) :type pathname :initarg :path :accessor path)
78
    (base :type string :initarg :base :accessor containerfile-base)
79
    (args :initform nil :type list :initarg :args :accessor containerfile-args)
80
    (steps :initform (make-array 0 :element-type 'cons :adjustable t) :type (vector cons) :initarg :steps :accessor containerfile-steps)))
81
 
82
 (defmethod serde ((from containerfile) (to pathname))
83
   (with-open-file (file to :direction :output)
84
     (when-let ((base (containerfile-base from)))
85
       (write-containerfile-from base file))
86
     (loop for arg in (containerfile-args from)
87
           do (write-containerfile-arg arg file))
88
     (loop for step across (containerfile-steps from)
89
           do (write-containerfile-line step file))))
90
 
91
 (defmethod serde ((from stream) (to containerfile))
92
   (multiple-value-bind (base args) (read-containerfile-start from)
93
     (setf (containerfile-base to) base)
94
     (setf (containerfile-args to) args))
95
   (setf (containerfile-steps to)
96
         (coerce
97
          (loop for line = (trim (read-line from nil nil))
98
                while line
99
                unless (containerfile-comment-p line)
100
                collect (read-containerfile-line line))
101
          'simple-vector))
102
     to)
103
 
104
 (defmethod serde ((from pathname) (to containerfile))
105
   (with-open-file (file from)
106
     (setf (path to) from)
107
     (serde file to)))
108
 
109
 (defmethod serde ((from string) (to containerfile))
110
   (with-input-from-string (stream from)
111
     (serde stream to)))
112
 
113
 (defmethod deserialize ((from pathname) (format (eql :containerfile)) &key)
114
   (serde from (make-instance 'containerfile)))
115
 
116
 (defmethod serialize ((obj containerfile) (format (eql :string)) &key)
117
   (with-output-to-string (str)
118
     (loop for arg in (containerfile-args obj)
119
           while arg
120
           do (write-line arg str))
121
     (princ "FROM " str)
122
     (println (containerfile-base obj) str)
123
     (loop for step across (containerfile-steps obj)
124
           do (write-containerfile-line step str))
125
     str))
126
 
127
 (defmethod serialize ((obj containerfile) (format (eql :bytes)) &key)
128
   (sb-ext:string-to-octets (serialize obj :string)))